proc ModifyGlobalArray Tab {
    global $Tab
    set Elem [ChoixParmi [array names $Tab]]
    if {$Elem==""} { return "" }
    while {1} {
	set NouvelleValeur [Entre [set [set Tab]($Elem)]]
	if {$NouvelleValeur!="" || [OuiOuNon "Do you want to set it to empty value ?"]} { break }
    }
    set [set Tab]($Elem) $NouvelleValeur
    return $Elem
}

proc ModifyGlobalVariables {{Var ""}} {
    if {$Var==""} {
	set LesGlobales [lsort [info globals]]
	set Var [ChoixParmi $LesGlobales]
    }
    if {$Var==""} { return "" }
    global $Var
    if {[array exists $Var]} { return [ModifyGlobalArray $Var] }
    while {1} {
	set NouvelleValeur [Entre [set $Var]]
	if {$NouvelleValeur!="" || [OuiOuNon "Do you want to set it to empty value ?"]} { break }
    }
    set $Var $NouvelleValeur
    return $Var
}

proc RequireOnce args {
    set LesPacks $args
    global RequireOnce
    foreach Pack $LesPacks {
	if {[info exists RequireOnce($Pack)]} {continue}
	set RequireOnce($Pack) 1
	package require $Pack
	if {$Pack=="BLT"} {namespace import blt::*}
    }
}

proc PolicePourListBox {{PoliceOuAsk ""} {W ""}} {
    global PolicePourListBox

    Wup "returns or sets the current fontsize, asks if PoliceOuAsk is 'Ask' "

    if { ! [info exists PolicePourListBox]} {
	set PolicePourListBox 10
    }

    if {[regexp {^[0-9]+$} $PoliceOuAsk]} {
	set PolicePourListBox $PoliceOuAsk
    } elseif {[regexp -nocase {^Ask$} $PoliceOuAsk]} {
	set Police [ChoixParmi {6 8 10 12 14 16 18 20 22 24}]
	if {$Police!=""} { set PolicePourListBox $Police }
    }
    if {$W!=""} { $W.frame.list configure -font [list Courier $PolicePourListBox] }
    return $PolicePourListBox
}

proc PolicePourEntreTexte {{PoliceOuAsk ""} {W ""}} {
    global PolicePourEntreTexte

    Wup "returns or sets the current fontsize, asks if PoliceOuAsk is 'Ask' "

    if { ! [info exists PolicePourEntreTexte]} { set PolicePourEntreTexte 10 }

    if {[regexp {^[0-9]+$} $PoliceOuAsk]} {
	set PolicePourEntreTexte $PoliceOuAsk
    } elseif {[regexp -nocase {^Ask$} $PoliceOuAsk]} {
	set Police [ChoixParmi {6 8 10 12 14 16 18 20 22 24}]
	if {$Police!=""} { set PolicePourEntreTexte $Police }
    }
    set Objet "$W.text"
    if {[winfo exists $Objet]} { $Objet configure -font [list Courier $PolicePourEntreTexte] }
    return $PolicePourEntreTexte
}

proc CopieVersFichierBienNommePourLeRep {} {
    foreach F [glob -nocomplain "./*"] {
	Espionne [CopieVersFichierBienNomme $F]
    }
}

proc CopieVersFichierBienNomme F {
    if {[regexp {\#} $F]} {
	regsub -all {\#} $F "_" BonF
	if {[file exists $BonF] && [OuiOuNon "$F\nwill be copied to\n$BonF\n\nIt already exists. Do I skipp ?"]} {
	    return ""
	}
	if { ! [OuiOuNon "$F\nOk to copy it to\n$BonF"]} { return "" } 
	file copy -force $F $BonF
	return $BonF
    }
    return $F
}

proc EstUnFichierImage Fichier {
    return [regexp -nocase {\.jpe?g$|\.gif$|.tif$|\.tiff$|\.pnm$|\.pbm$|\.tga$} $Fichier]
}

proc GetGlobal Var {
    global $Var
    if { ! [info exists $Var]} { return "NotExists" }
    return [set $Var] 
}

proc FileExists Fichier {
    return [file exists $Fichier]
}

proc FileAbsent Fichier {
    if {[FileExists $Fichier]} { return 0 } else { return 1 }
}

proc DirExists Dir {
    return [file exists $Dir]
}

proc DirAbsent Dir {
    if {[DirExists $Dir]} { return 0 } else { return 1 }
}

proc CreateDirIfAbsent Dir {
    if {[DirExists $Dir]} { return "" }
    file mkdir $Dir
    return $Dir
}

proc GscopeSubDir SousRep {
    return "[RepertoireDuGenome]/$SousRep"
}

proc GscopeFile {Nom {SousRep ""}} {
    if {$SousRep==""} {
	if {[OnTraiteDesProteines]} {
	    set SousRep "prottfa"
	} else {
	    set SousRep "nuctfa"
	}
    }
    return "[GscopeSubDir $SousRep]/$Nom"
}

proc AllerRetour {In {Out ""} {N ""}} {
    if {$Out==""} { set Out "${In}_new" }
    if {$N==""} { set N 1 }
    set Liste [LesLignesDuFichier $In]
    set ListeRetourne [RetourneLaListe $Liste]
    set LiiL [concat $Liste $ListeRetourne]
    set Finale {}
    foreach i [NombresEntre 1 $N] {
	set Finale [concat $Finale $LiiL]
    }
    return [SauveLesLignes $Finale dans $Out]
}

proc AllToTitle Texte {
    set AlphAvant 0
    foreach C [split $Texte ""] {
	if {$AlphAvant} {
	    append Nouveau [string tolower $C]
	} else {
	    append Nouveau [string toupper $C]
	}	    
	set AlphAvant [regexp -nocase {[a-z]} $C]   
    }
    return $Nouveau
}

proc BonParenthesageDuFichier {Fichier} {
    return [BonParenthesage [ContenuDuFichier $Fichier]]
}

proc BonParenthesage Texte {
    set iC 0
    set iA 0
    set iP 0
    set DejaLu ""
    set YaBackSlash 0
    foreach C [split $Texte ""] {
	append DejaLu $C

	if {$YaBackSlash} { set YaBackSlash 0 ; continue }
	if {$C=="\\"} { set YaBackSlash 1 ; continue}

	if {$C=="\["} { incr iC ; continue}
	if {$C=="\{"} { incr iA ; continue}
	if {$C=="\("} { incr iP ; continue}
	if {$C=="\]"} { incr iC -1}
	if {$C=="\}"} { incr iA -1}
	if {$C=="\)"} { incr iP -1}
	if {$iC<0} { return "Unexpected '\]' at [string range $DejaLu end-40 end]" }
	if {$iA<0} { return "Unexpected '\}' at [string range $DejaLu end-40 end]" }
	if {$iP<0} { return "Unexpected '\)' at [string range $DejaLu end-40 end]" }
    }
    if {$iC>0} { return "Missing '\]' at [string range $DejaLu end-40 end]" }
    if {$iA>0} { return "Missing '\}' at [string range $DejaLu end-40 end]" }
    if {$iP>0} { return "Missing '\)' at [string range $DejaLu end-40 end]" }
    return ""
}

proc AutorisationPourPsy {} {

    global AutorisationPourPsy
    if { ! [info exists AutorisationPourPsy]} {
	set AutorisationPourPsy -3
    }

    if { $AutorisationPourPsy==1 } { return 1 }
    if { $AutorisationPourPsy==0 } { return 0 }
    set Cou [Entre "Donnez la plus belle couleur pour une 2cv : "]   
    incr AutorisationPourPsy
    if { ! [regexp -nocase "rouge" $Cou] } { return 0 }
    set AutorisationPourPsy 1
    return 1
}

proc GscopeEvaluates LesMotsDeLaCommande {

    if {[lindex $LesMotsDeLaCommande 0]=="data"} {
	set RG [lindex $LesMotsDeLaCommande 1]
	RepertoireDuGenome $RG
	set LesMotsDeLaCommande [lreplace $LesMotsDeLaCommande 0 1]
    }
    
    if {[lindex $LesMotsDeLaCommande 0]=="PourWscope"} {
	PourWscope 1
	set LesMotsDeLaCommande [lreplace $LesMotsDeLaCommande 0 0 yes]
    }
    
    if {[regexp -nocase {[a-z]} $LesMotsDeLaCommande]} {
	
	ChargeConfig
	
	set QuoiFaire [lindex $LesMotsDeLaCommande 0]
	if {$QuoiFaire == "only"} {
	    set Sortie [eval [lrange $LesMotsDeLaCommande 1 end]]
	    return
	}
	
	set Commande [join $LesMotsDeLaCommande " "]
	wm title . "[PreFixe] [string range $Commande 0 20]"
	
	set Process "Gscope [PreFixe] on [info hostname]\n pid [pid] since [Date Nice]"
	button .kill -text "$Process\n\nStop execution of : \n\n$Commande\n\nby pressing Me or killing this window" \
		-background "yellow" -command "exit"
	pack   .kill -fill both
	
	
	if {[regexp "^yes" $QuoiFaire]} {	
	    global OuiOuNonToujoursParDefaut ; set OuiOuNonToujoursParDefaut 1
	    global EspionneNon ; set EspionneNon 1
	    global FaireLireNon ; set FaireLireNon 1
	    global EntreToujoursDefaut ; set EntreToujoursDefaut 1
	    global JavaDisponible ; set JavaDisponible 0
	    regsub "^yes" $QuoiFaire "" QuoiFaire
	    if {$QuoiFaire==""} { set QuoiFaire "exe" }
	    if {$QuoiFaire=="con"} {
		set QuoiFaire ""
		set LesMotsDeLaCommande [lrange $LesMotsDeLaCommande 1 end]
	    }
	}
	
	if {$QuoiFaire == "puts" || $QuoiFaire == "putl" || $QuoiFaire == "exe"} {
	    set Sortie [eval [lrange $LesMotsDeLaCommande 1 end]]
	    if {$QuoiFaire == "putl" && $Sortie==""} { puts "" }
	    if {$QuoiFaire == "putl" && $Sortie!=""} { puts [join $Sortie "\n"] }
	    if {$QuoiFaire == "puts"               } { puts       $Sortie       }
	    exit
	}
	
	eval $LesMotsDeLaCommande
    }
    return
}

proc NucOuProt Sequence {
    if {[regexp "^>" $Sequence]} { set Sequence [QueLaSequenceDuTexteTFA $Sequence] }
    if {[regexp -nocase {[^ATGCNXMKRSYWVHDB]} $Sequence]} { return "Prot" }
    return "Nuc"
}

proc JeCommenceABosser {} {
    set LesBoulots [list \
	    "FantomisePourTous {} AskWhereToBegin" \
	    "EtudeCodonStart AskWhereToBegin" \
	    "CoupeAuBonMetPourTous AskWhereToBegin" \
	    ]
    set Boulot [ChoixParmi $LesBoulots]
    if {$Boulot==""} { return "" }
    JeVaisBosser $Boulot
    eval $Boulot
}

proc JeVaisBosser {Texte} {
    global Bosseurs
    set Moi [TmpFile Bosse]
    set Bosseurs($Texte) $Moi
    set Bosseurs($Moi) $Texte
    return $Moi
}

proc JArreteDeBosser Moi {
    global Bosseurs    
    if { ! [file exists $Moi]} { return 0 }
    file delete -force $Moi
    set Texte [set Bosseurs($Moi)]
    unset Bosseurs($Moi)
    unset Bosseurs($Texte)
    return 1
}

proc TuArretesDeBosser {} {
    global Bosseurs
    set LesTextes [list "Select the process you want to stop"]
    foreach Texte [array names Bosseurs] {
	if {[regexp "/" $Texte]} { continue }
	lappend LesTextes $Texte
    }
    set Texte [ChoixParmi $LesTextes]
    if {$Texte=="" || ! [info exists Bosseurs($Texte)]} { return "" }
    set Toi [set Bosseurs($Texte)]
    if {$Toi==""} { return "" }
    Sauve $Texte dans $Toi
    return $Toi
}

proc RenumeroteLesPABs {} {
    foreach Fichier [glob "[RepertoireDuGenome]/*/MSME*"] {
	if {[regexp {MSME[0-9]{4}$} $Fichier]} {
	    set Nom [file tail $Fichier]
	    set Rep [file dirname $Fichier]
	    regsub "MSME" $Nom "MSME0" Bon
	    file rename $Fichier "$Rep/$Bon"
	    Espionne "[file tail $Rep] $Nom $Bon"
	}
    }
    exit
}

proc MailFichier {Fichier {Destinataire ""} {Sujet ""}} {

    global env

    if {$Destinataire==""} {
	set MySelf [set env(USER)]
	set Destinataire "$MySelf@igbmc.u-strasbg.fr"
    }

    if { ! [file exists $Fichier]} {
	FaireLire "$Fichier doesn't exist. Sorry"
	return ""
    }
    if {$Sujet==""} {
	set Sujet [file tail $Fichier]
	regsub ".txt$" $Sujet "" Sujet
	set Subject "Commande oligos $Sujet"
    } else {
	set Subject $Sujet
    }
    set Message ""
    set CommandeMail "mail"
    if {[info exists env(HOSTTYPE)] && $env(HOSTTYPE)=="alpha"} { set CommandeMail "mailx" }
    if {[catch {exec $CommandeMail -s $Subject $Destinataire < $Fichier} Message]} {
	FaireLire "Error during mail. \nI got following error message :\n$Message"
	return $Message
    }

    return $Fichier
}

proc PlusProcheCodon {Ref LesPossibles} {

    foreach Rare [CodonsRares LaListeMerci] {
	set EstRare($Rare) 1
    }

    set Ref [string toupper $Ref]
    set PlusProche ""
    set OldEgaux -2
    foreach Codon $LesPossibles {
	set Codon [string toupper $Codon]
	if {[info exists EstRare($Codon)]} {
	    set nEgaux -1
	} else {
	    set nEgaux 0
	    foreach A [split $Ref ""] B [split $Codon ""] {
		if {$A==$B} { incr nEgaux }
	    }
	}
	if {$nEgaux > $OldEgaux} {
	    set OldEgaux $nEgaux
	    set PlusProche $Codon
	}
    }
    return $PlusProche
}

proc LesCodesGenetiques P {
    global LesCodesGenetiques


    Wup "We replace O (the coding of STOP in MutaSequence) by * (O is not used as aa code)" 
    if {$P=="O"} { set P "*" }

    set P [string toupper $P]
    if {$P=="STOP"} { set P "*" }
    if {[string length $P]==3} { set P [UT $P] }

    if {[info exists LesCodesGenetiques($P)]} { return [set LesCodesGenetiques($P)] }
    if {[info exists LesCodesGenetiques("EstCharge")]} { return "NNN" }

    set LesCodesGenetiques("EstCharge") 1
    foreach A {A T G C} {
	foreach B {A T G C} {
	    foreach C {A T G C} {
		set Codon "$A$B$C"
		set AA [AAduCodon $Codon]
		lappend LesCodesGenetiques($AA) $Codon
		lappend LesCodesGenetiques(LALISTEMERCI) "$Codon $AA"
	    }
	}
    }
    return [LesCodesGenetiques $P]
}

proc TesteTouteLaBalise {} {
    Espionne [TouteLaBalise protein match.xml]
    Espionne [TouteLaBalise protein]
    Espionne [TouteLaBalise protein match.xml "CloseFileAfterRead"]
    Espionne [TouteLaBalise protein match.xml]
    Espionne [TouteLaBalise protein "" "CloseFileAfterRead"]
    Espionne [TouteLaBalise protein match.xml]
}

proc TouteLaBalise {Bal {Fichier ""} {Close ""}} {
    global CanalPourTouteLaBalise FichierPourTouteLaBalise

    if {$Bal=="CloseFilePlease"} {
	if {[info exists CanalPourTouteLaBalise]} {
	    close $CanalPourTouteLaBalise
	    unset CanalPourTouteLaBalise
	    unset FichierPourTouteLaBalise
	}
    }

    set CloseFileIfEmpty   [string equal $Close "CloseFileIfEmpty"]
    set CloseFileAfterRead [string equal $Close "CloseFileAfterRead"]

    if {[info exists FichierPourTouteLaBalise]} {
	if {$Fichier!="" && $FichierPourTouteLaBalise != $Fichier} {
	    close $CanalPourTouteLaBalise
	    unset CanalPourTouteLaBalise
	} 
    }
    if { ! [info exists CanalPourTouteLaBalise] } {
	set FichierPourTouteLaBalise $Fichier
	set CanalPourTouteLaBalise [open $FichierPourTouteLaBalise "r"]
    }

    if {$Bal=="OpenFilePlease"} { return $CanalPourTouteLaBalise }

    set LesLignes {}
    while {[gets $CanalPourTouteLaBalise Ligne] >= 0} {
	if {[regexp "\<$Bal " $Ligne] || [regexp "\<$Bal *\>" $Ligne]} { set LesLignes [list $Ligne] ; break }
    }
    if {$LesLignes=={}} {
	if {$CloseFileIfEmpty} {
	    if {[info exists CanalPourTouteLaBalise]} {
		close $CanalPourTouteLaBalise
		unset CanalPourTouteLaBalise
		unset FichierPourTouteLaBalise
	    }
	}
	return ""
    }
    while {[gets $CanalPourTouteLaBalise Ligne] >= 0} {
	lappend LesLignes $Ligne
	if {[regexp "</$Bal *>" $Ligne]} { break } 
    }
    if {$CloseFileAfterRead} {
	if {[info exists CanalPourTouteLaBalise]} {
	    close $CanalPourTouteLaBalise
	    unset CanalPourTouteLaBalise
	    unset FichierPourTouteLaBalise
	}
    }
    return [join $LesLignes "\n"]
}

proc LigneDesMots {Ligne {REX ""}} {
    if {$REX==""} { set REX "\;" }
    regsub -all "$REX|\t" $Ligne " " Ligne
    while {[regexp "  " $Ligne]} { regsub -all "  " $Ligne " " Ligne }
    set Ligne [string trim $Ligne]
    return $Ligne
}

proc LesMotsDeLaLigne {Ligne {REX ""}} {
    return [split [LigneDesMots $Ligne $REX] " "]
}

proc IntegerToAscii I {
    set Ascii [format "%c" $I]
    return $Ascii
}

proc HexaToAscii Hex {
    regsub "^%" $Hex "" Hex
    regsub -nocase "^ox" $Hex "" Hex
    set Ascii [format "%c" 0x$Hex]
    return $Ascii
}

proc LesCaracteresAscii {} {
    foreach n [NombresEntre 32 256] {
	lappend LesCars "[IntegerToAscii $n] $n"
    }
    return $LesCars
}

proc TexteAscii Texte {
    regsub -all "%0D" $Texte "%0A" Texte
    while {[regexp -nocase {%[0-9a-h]{2}} $Texte Hexa]} {
	set Car [HexaToAscii $Hexa]
	regsub -all $Hexa $Texte $Car Texte
    }
    return $Texte
}

proc SousListe ListeDepart {
    set ListeDepart [ListeDesPABs]
    if {$ListeDepart=={}} { return {} }
    FaireLire "Please select two elements within following elements"
    while 1 {
	set BornesSubList [Entre "[lindex $ListeDepart 0] [lindex $ListeDepart end]"]
	if {$BornesSubList==""} { return "" }
	scan $BornesSubList "%s %s" Prems Derns
	set D [lsearch -exact $ListeDepart $Prems]
	set F [lsearch -exact $ListeDepart $Derns]
	if {$D<0 || $F<0} {
	    FaireLire "Please select two elements within\n$ListeDeDepart"
	    continue
	}
	set Liste [lrange $ListeDepart $D $F]
	if {$Liste!={} || [OuiOuNon "I got an empty list ... is it OK ?"]} { break }
    }
    return $Liste
}

proc TouchePour {Clavier Texte {Commande ""} {Action ""} {Couleur ""}} {
    global TouchePour

    if {[regexp "<" $Clavier]} {
	set Bouton [set TouchePour(BoutonCourant)]
	set NewTexte [lindex [$Bouton configure -text] 4]
	append NewTexte $Texte
	$Bouton configure -text $NewTexte 
	bind $Bouton $Clavier $Commande
	return $Bouton
    }

    if {$Texte=="NouvelleCouleur"} {
	set TouchePour($Clavier,Couleur) $Commande
	return [set TouchePour($Clavier,Couleur)]
    }

    if {$Texte=="NouvelleGamme"} {
	if {[PourWscope]} { return }
	if { ! [info exists TouchePour($Clavier,Gamme)]} {
	    set TouchePour($Clavier,Gamme) -1
	}
	set Gamme [incr TouchePour($Clavier,Gamme)]
	set    DestFrame "$Clavier.gamme$Gamme"
	frame $DestFrame
	 pack $DestFrame -side "left" -fill x -pady 0 -anchor "n"
	set TouchePour($Clavier,DestFrame) $DestFrame
	return $DestFrame
    }

    if {$Action=="NoWeb"} { set NoWeb 1 } else { set NoWeb 0 }
    if {$NoWeb && [PourWscope]} { return "" }

    if { ! [info exists TouchePour($Clavier,nTouches)]} {
	set TouchePour($Clavier,nTouches) -1
    }
    if { ! [info exists TouchePour($Clavier,Couleur)]} {
	set TouchePour($Clavier,Couleur) "grey"
    }
    set B [incr TouchePour($Clavier,nTouches)]
    if {$Couleur==""} {
	set Couleur [set TouchePour($Clavier,Couleur)]
    }

    set Bouton "$Clavier.touche$B"
    button $Bouton -text $Texte -background $Couleur -foreground black -relief raise -width 15 -height 1 -pady 0
      bind $Bouton <1> $Commande

    if { ! [PourWscope]} {
	pack $Bouton -in [set TouchePour($Clavier,DestFrame)] -side "top" -expand 1
    }
    set TouchePour(BoutonCourant) $Bouton
    return $Bouton
}

proc CreeLeRepertoire Rep {
    if {$Rep=="" || [file exists $Rep]} { return $Rep }
    set Parent [file dirname $Rep]
    if { ! [file exists $Parent]} { set Parent [CreeLeRepertoire $Parent] }
    if {$Parent=="" ||  ! [file exists $Parent]} { return "" }
    file mkdir $Rep
    if {[file exists $Rep]} { return $Rep }
    return ""
}

proc ChoixDuRepertoire {{RepInitial ""}} {
    if {$RepInitial==""} { set RepInitial "./" }
# BUG dans Tk ... initialdir n'est pas pris
    set Rep [tk_chooseDirectory -initialdir $RepInitial]
    if {$Rep==""} { return "" }
    if {[file exists $Rep]} { return $Rep }
    if { ! [OuiOuNon "Do I create the directory\n$Rep ?"]} { FaireLire "Tant pis" ; return $Rep }
    set RepCree [CreeLeRepertoire $Rep]
    if {$RepCree!=""} {
	FaireLire "I created $Rep"
	return $RepCree
    }
    FaireLire "I couldn't create $Rep\nWe'll try again"
    return [ChoixDuRepertoire $RepInitial]
}

proc LesFichiersQuiCommencentPar {Texte {Rep ""} {Extension ""}} {
    if {$Rep!="" && [regexp "/$" $Rep]} { append Rep "/" } 
    set LesBons {}
    foreach Fichier [glob -nocomplain "${Rep}*$Extension"] {
	if {[regexp -nocase -- "^$Texte" [file tail $Fichier]]} { lappend LesBons $Fichier }
    }
    return "$LesBons"
}

proc Tx {{D ""} {F ""}} {
    global Tx TxD TxF

    if {$D==""} { set D $TxD }
    if {$F==""} { set F $TxF }

    return [string range $Tx $D $F]
}



proc PrintEnv Variable {
    global env

    if {$Variable=="all"} {
	return [array get env]
    }

    if {[info exists env($Variable)]} { return $env($Variable) }
    return "$Variable iiiiiiiiiiiiiiiiiiiiinconnu"
}

proc LesBoutonsDeLaFrame F {
    set LesBoutons {}
    foreach Bouton [winfo children $F] {
	if {[winfo class $Bouton]!="Button"} { continue }
	lappend LesBoutons $Bouton
    }
    return $LesBoutons
}

proc PourWscope {{NouvelleValeur ""}} {
    global PourWscope
    if {$NouvelleValeur!=""} {
	set PourWscope $NouvelleValeur
    }
    if { ! [info exists PourWscope]} { set PourWscope 0 }
    return $PourWscope
}

proc ItemHTMLFermant Item {
    global ItemHTMLFermant
    if {[info exists ItemHTMLFermant($Item)]} { return $ItemHTMLFermant($Item) }
    set Item [string tolower $Item]
    set LesSimples {area img ox os oc ac de gn id pn}
    if {[lsearch -exact $LesSimples $Item]>=0} { return ">" }
    if {[string equal -nocase $Item "LI"]} { return "<LI>" }
    return "</$Item>"
}

proc AttributsDeLaBalise {Item aTexte {Rogner "NePasRogner"}} {
    upvar $aTexte Texte
    ValeurDeLaBalise $Item $aTexte $Rogner A
    return $A
}

proc thtml {} {

    set T [ContenuDuFichier trp7_human.blastp]

    set B [ProchaineBalise T Attrib "Rogner"]
    Espionne "Attributs de $B : $Attrib"
    set B [ProchaineBalise T Attrib "Rogner"]
    Espionne "Attributs de $B : $Attrib"

    set Iter [ValeurDeLaBalise "Iteration" T]
    set Num  [ValeurDeLaBalise "Iteration_iter-num" Iter]
    set Hits [ValeurDeLaBalise "Iteration_hits" Iter]
    set Stat [ValeurDeLaBalise "Iteration_stat" Iter]
    Espionne "Num =$Num="
    Espionne $Stat

    while 1 {
	set Hit     [ValeurDeLaBalise "Hit" Hits "" "Rogner"]
	set Hit_def [ValeurDeLaBalise "Hit_def" Hit "NePasRogner"]
	set Hit_id  [ValeurDeLaBalise "Hit_id"  Hit "NePasRogner"]
	Espionne "$Hit_id  $Hit_def"
	while 1 {
	    set BH [ProchaineBalise Hit "" "Rogner"]
	    if {$BH==""} { break }
	    Espionne "    $BH"
	}
    }
    exit

    exit
    foreach BornesDuHit [LesSousChamps $Hits] {
	scan $BornesDuHit "%d %d" D F
	set Hit [string range $Hits $D $F]
	Espionne [string range $Hit 0 300]
	set Hit_def [ValeurDeLaBalise "Hit_def" Hit "NePasRogner"]
	set Hit_id  [ValeurDeLaBalise "Hit_id"  Hit "NePasRogner"]
	Espionne "$Hit_id  $Hit_def"
	while 1 {
	    set BH [ProchaineBalise Hit "" "Rogner"]
	    if {$BH==""} { break }
	    Espionne "    $BH"
	}
    }
    exit

    Recure $T


    while 1 {
	set Bal [ProchaineBalise T Attrib]
	if {$Bal==""} { break }
	set Val [ValeurDeLaBalise $Bal T]
	Espionne "=$Bal=[string range $Val 0 50]"
    }
    exit
}

proc LesSousChamps {T {Champ ""}} {

    set Balise [ProchaineBalise T]
    if {$Champ!="" && ! [string equal -nocase $Balise $Champ]} { return {}}
    Espionne $Balise

    set LesValeurs {}
    set i 5
    while 1 {
	if {[incr i -1]==0} { break }
	set Valeur [ValeurDeLaBalise $Balise T]
	if {$Valeur==""} { break }
	lappend LesValeurs $Valeur
#	Espionne [string range $Valeur 0 300]
    }
    return $LesValeurs
} 

proc Recure W {
    global Indentation
    while 1 {
	set B [ProchaineBalise W]
	if {$B==""} { Espionne "[string repeat " " $Indentation] $W" ; break }
	set V [ValeurDeLaBalise $B W]
	if { ! [info exists Indentation]} { set Indentation 1 }
	Espionne "[string repeat " " $Indentation] ($B)"
	if {$V==""} { continue }
	incr Indentation
	Recure $V
	incr Indentation -1
    }
    return ""
}

proc ProchaineBalise {aTexte {aAttributs ""} {Rogner "NePasRogner"}} {
    upvar $aTexte Texte
    if {$aAttributs!=""} { upvar $aAttributs Attributs ; set Attributs ""}

    set Rogner [expr ! [string equal $Rogner "NePasRogner"]]

    if { ! [regexp -indices -nocase {<[^ >]+} $Texte Indices]} { return "" }
    set DebItem [lindex $Indices 0]
    set FinItem [lindex $Indices 1]

    set Balise [string range $Texte [incr DebItem] $FinItem]

    set NouveauTexte [string range $Texte $FinItem end]
    set iChevronFermant [string first ">" $NouveauTexte]
    if {$iChevronFermant<0} { return "" }
    set Attributs [string range $NouveauTexte 0 $iChevronFermant]
    set LongAttributs [string length $Attributs]
    regsub ">" $Attributs "" Attributs
    set Attributs [string trim $Attributs]
    set NouveauTexte [string range $NouveauTexte $LongAttributs end]

    set Fermant [ItemHTMLFermant $Balise]
    regsub -all -- "-" $Fermant "\-" FermantX
    if { ! [regexp -indices -nocase "$FermantX" $NouveauTexte Indices]} { return "" }
    set iFin [lindex $Indices 0]
    set Derriere [expr [lindex $Indices 1] + 1]

    set Valeur [string range $NouveauTexte 0 [expr $iFin - 1]]
    if {$Rogner} { set Texte [string range $NouveauTexte $Derriere end] }
    return $Balise
}

proc OldProchaineBalise {} {
    set iChevron [string first "<" $Texte]
    if {$iChevron<0} { return "" }
    set Zone [string range $Texte [expr $iChevron+1] end]
    set Balise ""
    if { ! [regexp {[^ >]+} $Zone Balise]} { return "" }
    regsub ">" $Balise "" Balise
    if {$Balise==""} { return "" }

    incr iChevron [string length "<$Balise"]
    set NouveauTexte [string range $Texte $iChevron end]
    set iChevronFermant [string first ">" $NouveauTexte]
    if {$iChevronFermant<0} { return "" }
    set Attributs [string range $NouveauTexte 0 $iChevronFermant]
    set LongAttributs [string length $Attributs]
    regsub ">" $Attributs "" Attributs
    set Attributs [string trim $Attributs]

    if {$Rogner} { set Texte [string range $NouveauTexte $LongAttributs end] }

    return $Balise
}

proc RRGardeLesEucaryotes {Fichier} {
    set LesEucaryotes {}
    set Texte [ContenuDuFichier $Fichier]
    while {[set BH [ValeurDeLaBalise "BlastHit" Texte]]!=""} {
	set AC [ValeurDeLaBalise AC BH NePasRogner]
	set OX [ValeurDeLaBalise OX BH NePasRogner]
	set DE [ValeurDeLaBalise DE BH NePasRogner]
	Espionne "OX $OX"
	set HasEuka 0
	foreach TaxId [split $OX " "] {
	    regsub {[^0-9]} $TaxId "" TaxId
	    if { ! [EstUnEucaryote $TaxId]} { continue }
	    set HasEuka 1
	    break
	}
	Espionne "$HasEuka $BH"
	if {$OX!="" && ! $HasEuka} { continue }
#	AppendAuFichier les_eucaryotes $Ligne
	lappend LesEucaryotes $BH
    }
    return $LesEucaryotes
}

proc OLDRRGardeLesEucaryotes {Fichier} {
    set LesEucaryotes {}
    foreach Ligne [LesLignesDuFichier $Fichier] {
	set A "" ; set O "" ; set D ""
	set Texte $Ligne
	set AC [ValeurDeLaBalise AC Texte NePasRogner A]
	Espionne "valeur $AC"
	set OX [ValeurDeLaBalise OX Texte NePasRogner O]
	set DE [ValeurDeLaBalise DE Texte NePasRogner D]
	set HasEuka 0
	foreach TaxId [split $O " "] {
	    regsub {[^0-9]} $TaxID "" TaxId
	    if { ! [EstUnEucaryote $TaxId]} { continue }
	    set HasEuka 1
	    break
	}
	Espionne "$HasEuka $Ligne"
	if {$O!="" && ! $HasEuka} { continue }
#	AppendAuFichier les_eucaryotes $Ligne
	lappend LesEucaryotes $Ligne
    }
    return $LesEucaryotes
}

proc TesteValeurDeLaBalise {} {
    set Texte "<BlastHit Q8EYZ8> <AC Q8EYZ8> <ID Q8EYZ8> <OX 173> <DE Putative pyrophosphatase.> <OS Leptospira interrogans.></BlastHit>"
    set V [ValeurDeLaBalise BlastHit Texte "NePasRogner" A]
    Espionne "Valeur >$V<"
    Espionne "Attrib >$A<"
    Espionne "/$Texte/"
    set V [ValeurDeLaBalise DE Texte "NePasRogner" A]
    Espionne "Valeur >$V<"
    Espionne "Attrib >$A<"
    Espionne "/$Texte/"
    set V [ValeurDeLaBalise AC Texte "NePasRogner" A]
    Espionne "Valeur >$V<"
    Espionne "Attrib >$A<"
    Espionne "/$Texte/"
    Espionne [AttributsDeLaBalise DE Texte]
    exit
}

proc ValeurDeLaBalise {Item aTexte {Rogner "Rogner"} {aAttributs ""}} {
    upvar $aTexte Texte
    if {$aAttributs!=""} { upvar $aAttributs Attributs }

    set Rogner [expr ! [string equal -nocase $Rogner "NePasRogner"]]

    regsub -all -- "-" $Item "\-" ItemX
    if { ! [regexp -indices -nocase "<${ItemX}(>| )" $Texte Indices]} { return "" }
    set FinItem [lindex $Indices 1]
    set NouveauTexte [string range $Texte [expr $FinItem] end]
    set iChevronFermant [string first ">" $NouveauTexte]
    if {$iChevronFermant<0} { return "" }
    set Attributs [string range $NouveauTexte 0 $iChevronFermant]
    set LongAttributs [string length $Attributs]
    regsub ">" $Attributs "" Attributs
    set Attributs [string trim $Attributs]
    set NouveauTexte [string trim [string range $NouveauTexte $LongAttributs end]]

    set Fermant [ItemHTMLFermant $Item]
    if {$Fermant==">"} {
	set Valeur $Attributs
	set Derriere 0
    } else {
	regsub -all -- "-" $Fermant "\-" FermantX
	if { ! [regexp -indices -nocase "$FermantX" $NouveauTexte Indices]} { return "" }
	set iFin [lindex $Indices 0]
	if {[regexp {<[^/]} $FermantX]} {
	    set Derriere [expr $iFin - 1]
	} else {
	    set Derriere [expr [lindex $Indices 1] + 1]
	}
	set Valeur [string range $NouveauTexte 0 [expr $iFin - 1]]
    }
    if {$Rogner} { set Texte [string range $NouveauTexte $Derriere end] }
    return $Valeur
}

proc OLDValeurDeLaBalise {Item aTexte {Rogner "Rogner"} {aAttributs ""}} {
    upvar $aTexte Texte
    if {$aAttributs!=""} { upvar $aAttributs Attributs }

    set Rogner [expr ! [string equal $Rogner "NePasRogner"]]

    regsub -all -- "-" $Item "\-" ItemX
    if { ! [regexp -indices -nocase "<${ItemX}(>| )" $Texte Indices]} { return "" }
    set FinItem [lindex $Indices 1]
    set NouveauTexte [string range $Texte [expr $FinItem+1] end]
    set iChevronFermant [string first ">" $NouveauTexte]
    if {$iChevronFermant<0} { return "" }
    set Attributs [string range $NouveauTexte 0 $iChevronFermant]
    set LongAttributs [string length $Attributs]
    regsub ">" $Attributs "" Attributs
    set Attributs [string trim $Attributs]
    set NouveauTexte [string range $NouveauTexte $LongAttributs end]

    set Fermant [ItemHTMLFermant $Item]
    regsub -all -- "-" $Fermant "\-" FermantX
    if { ! [regexp -indices -nocase "$FermantX" $NouveauTexte Indices]} { return "" }
    set iFin [lindex $Indices 0]
    if {[regexp {<[^/]} $FermantX]} {
	set Derriere [expr $iFin - 1]
    } else {
	set Derriere [expr [lindex $Indices 1] + 1]
    }

    set Valeur [string range $NouveauTexte 0 [expr $iFin - 1]]

    if {$Rogner} { set Texte [string range $NouveauTexte $Derriere end] }
    return $Valeur
}

proc Garde {Fichier {Granularity "Seconde"}} {
    if { ! [file exists $Fichier]} { return "" }

    if {$Granularity=="Minute"} {
	set Time 60000
	set Extension [Date]
    } else {
	set Time 1000
	set Extension [Date "Seconds"]
    }
    set Nouveau "$Fichier.$Extension"
    if {[file exists $Nouveau]} { after $Time ; return [Garde $Fichier $Granularity] }
    File copy -force $Fichier $Nouveau
    if {[file exists $Nouveau]} { return $Nouveau }
    return ""    
}

proc Zippe {ListeA ListeB} {
    set LongPetite [Mini [llength $ListeA] [llength $ListeB]]
    foreach A [lrange $ListeA 0 $LongPetite] B [lrange $ListeB 0 $LongPetite] {
	lappend ListeAB $A $B
    }
    incr LongPetite
    if {[llength $ListeA] > $LongPetite} { return [concat $ListeAB [lrange $ListeA $LongPetite end]] } 
    if {[llength $ListeB] > $LongPetite} { return [concat $ListeAB [lrange $ListeB $LongPetite end]] }
    return $ListeAB
}

proc LesLignesVitales Fichier {

    Wup "Returns the lists of the lines from Fichier, accepts continuation and ignores # "

    set LesVitales {}
    set Lu ""
    foreach Ligne [LesLignesDuFichier $Fichier] {
	if {[regexp {\#} $Ligne]} {
	    regsub {\#.*$} $Ligne "" Ligne
	}
	if { ! [regexp -nocase {[^ ]} $Ligne]} { continue }

	if {[regexp {\\$} $Ligne]} {
	    regsub {\\$} $Ligne "" Ligne
	    append Lu $Ligne
	} else {
	    append Lu $Ligne
	    lappend LesVitales $Lu
	    set Lu ""
	}
	
    }
    return $LesVitales
}

proc AttendreLeFichier {Fichier {TimeOut ""}} {

    set Attente 1000
    while { 1 } {
	if {[file exists $Fichier]} { return $Fichier }
	if {$TimeOut != "" } {
	    set TimeOut [expr $TimeOut-$Attente]
	    if {$TimeOut<0} { return "" }
	}
	after $Attente
    }
}

proc PourGscopeServer {} {
   return 0
}

proc NextALPHA S {
    if {$S==""} { return "A" }
    set F [string index $S end]
    if {$F < "A" || "Z" < $F} { return "${S}A" }
    if {$F < "Z"} { 
	scan $F "%c" I 
	set N [format "%c" [incr I]]
	return [string replace $S end end $N]
    }
    set Avant [string range $S 0 end-1]
    return "[NextALPHA $Avant]A"
}

proc Echange {aA aB} {
    upvar $aA A
    upvar $aB B
    set W $A
    set A $B
    set B $W
    return
}

proc ImprimeLeTexte {Texte {Commande ""}} {
    set Fichier "[TmpFile].txt"
    set Fichier [Sauve $Texte dans $Fichier]
    if {$Fichier==""} {
	FaireLire "I couldn't create $Fichier for printing"
	return ""
    }
    if {$Commande==""} { set Commande "renoir" }
    return [ImprimeLeFichier $Fichier $Commande]
}

proc ImprimeLeFichier {Fichier {Commande ""}} {
    global CommandePrint
    
    Gs "Ignorer"
    
    if { ! [info exists CommandePrint]} { set CommandePrint "renoir" }
    if {$Commande==""} { set Commande $CommandePrint }
    set CommandePrint "$Commande $Fichier"
    if {[OuiOuNon "$CommandePrint\n\nDo You want to edit this print command ?"]} {
	set CommandePrint [Entre $CommandePrint]
    }
    eval exec $CommandePrint
    return $Fichier
}

proc SubstitueAvecBlancsDevant {Texte A B} {

    regexp -indices $A $Texte Indices
    scan $Indices "%d %d" d f
    incr d -1
    while {$d>0 && [string index $Texte $d]==" "} { incr d -1 }
    incr d 2
    set LongBlancAvant [expr $f-$d+1-[string length $B]]
    set Platre "[string repeat " " $LongBlancAvant]$B"
    set NouveauTexte [string replace $Texte $d $f $Platre]
    return $NouveauTexte
}

proc ChoixParmiJoliDansListe Liste {
    set LesClefs {}
    set LesCouleurs {} 
    set LesTextes {}
    foreach {Clef Couleur Texte} $Liste {
	lappend LesClefs $Clef
	lappend LesCouleurs $Couleur
	if {$Texte==""} { set Texte $Clef } 
	lappend LesTextes $Texte
    }
    return [ChoixParmiJoli $LesClefs $LesCouleurs $LesTextes]
}

proc ChoixParmiJoli {Liste {ListeDeCouleurs {}} {ListeAAfficher {}}} {
    global retourChoixParmi

    if {[llength $Liste] == 0 } { return "" }
    if {[llength $Liste] == 1 && [lindex $Liste 0]!="Other"} { return [lindex $Liste 0] }

    global ChoixParmiDansListBox
    if {([info exists ChoixParmiDansListBox] && $ChoixParmiDansListBox) || [llength $Liste]>40} {
	return [ChoixParmiDansListBox $Liste $ListeAAfficher]
    }

    set w [NomDe fenetre]
    catch {destroy $w}
    catch {unset retourChoixParmi}
    toplevel $w
    wm geometry $w +300+100

    set Invite "Choose ..."
    set InListBox "Same display in a listbox"
    set Salut  "... DISMISS"

    if {$ListeAAfficher=={}} { set ListeAAfficher $Liste }

    tk_optionMenu $w.o retourChoixParmi $Invite
    $w.o.menu add radiobutton -label $InListBox -background "orange" -variable retourChoixParmi
    $w.o configure -background "Seagreen" -foreground "black" -bd 20
    foreach Element $Liste Couleur $ListeDeCouleurs Affiche $ListeAAfficher {
	while {[info exists MonRetour($Affiche)]} { append Affiche "_" } 
	set MonRetour($Affiche) $Element
	if { $Couleur == "" } {
	    set Couleur "Seagreen"
	}
	$w.o.menu add radiobutton -background $Couleur -foreground "black" \
		-label $Affiche -variable retourChoixParmi
    }
    $w.o.menu add radiobutton -label $Salut -background "red" -variable retourChoixParmi
    
    pack $w.o

    tkwait variable retourChoixParmi
    destroy $w
    if { $retourChoixParmi == $InListBox } {
	set retourChoixParmi [ChoixParmiDansListBox $ListeAAfficher]
    }
    if { $retourChoixParmi == $Invite || $retourChoixParmi == $Salut } {
	set retourChoixParmi ""
    }
    if {$retourChoixParmi==""} { return "" }
    set Retour [set MonRetour($retourChoixParmi)]
    return $Retour
}

proc ChoixParmi {Liste {ListeDeCouleurs {}}} {
    global retourChoixParmi

    if {[llength $Liste] == 0 } { return "" }
    if {[llength $Liste] == 1  && [lindex $Liste 0]!="Other"} { return [lindex $Liste 0] }

    global ChoixParmiDansListBox
    if {[info exists ChoixParmiDansListBox] && $ChoixParmiDansListBox \
	|| [llength $Liste]>40} {
	return [ChoixParmiDansListBox $Liste]
    }

    set w [NomDe fenetre]
    catch {destroy $w}
    catch {unset retourChoixParmi}
    toplevel $w
    wm geometry $w +300+100

    set Invite "Choose ..."
    set InListBox "Same display in a listbox"
    set Salut  "... DISMISS"

    tk_optionMenu $w.o retourChoixParmi $Invite
    $w.o.menu add radiobutton -label $InListBox -background "orange" -variable retourChoixParmi
    $w.o configure -background "Seagreen" -foreground "black" -bd 20
    foreach Element $Liste Couleur $ListeDeCouleurs {
	if { $Couleur == "" } {
	    set Couleur "Seagreen"
	}
	$w.o.menu add radiobutton -background $Couleur -foreground "black" \
		-label $Element -variable retourChoixParmi
    }
    $w.o.menu add radiobutton -label $Salut -background "red" -variable retourChoixParmi
    
    pack $w.o

    tkwait variable retourChoixParmi
    destroy $w
    if { $retourChoixParmi == $InListBox } { return [ChoixParmiDansListBox $Liste] }
    if { $retourChoixParmi == $Invite || $retourChoixParmi == $Salut } {
	set retourChoixParmi ""
    }
    return $retourChoixParmi
}

proc ChoixParmiDansListBox {Liste {ListeAAfficher {}}} {
    set Choose "Select ONE of the following lines and press ACCEPT. Press DISMISS to cancel."
    if {$ListeAAfficher=={}} {
	set ListeA $Liste
    } else {
	set ListeA $ListeAAfficher
    }
    set ListeE [concat [list ""] $Liste]
    set ListeA [concat [list $Choose] $ListeA]
    foreach E $ListeE A $ListeA {
	while {[info exist ARetourner($A)]} {
	    set A "$A (bis)"
	}
	set ARetourner($A) $E
	lappend BonneListeA $A
    }
    set Texte [join $BonneListeA "\n"]
    set Retour [Affiche $Texte "AvecRienSansFetchAvecRetour" "SelectAndAccept"]
    if {$Retour==$Choose || $Retour==""} { return "" }
    return [set  ARetourner($Retour)]
}

proc WrapLeTexte {Texte {Largeur 50}} {
    if {[string length $Texte]<=$Largeur} { return [list $Texte] }
    set Entamme [string range $Texte 0 [expr $Largeur-1]]
    set DernierBlanc [string last " " $Entamme]
    if {$DernierBlanc<0} { set DernierBlanc $Largeur }
    set Entamme [string range $Texte 0 [expr $DernierBlanc - 1]]
    set Reste [string trim [string range $Texte $DernierBlanc end]]
    return [concat [list $Entamme] [WrapLeTexte $Reste $Largeur]]
}

proc LesLignesEntreExpressionsDuFichier {Fichier A B {BExclu "SecondExcluded"}} {

    if {$BExclu=="SecondIncluded"} {
	set BExclu 1
    } else {
	set BExclu 0
    }

    set OnYEst 0
    set LesBonnes {}
    foreach Ligne [LesLignesDuFichier $Fichier] {
	if {[regexp $A $Ligne]} {
	    set OnYEst 1
	}
	if {[regexp $B $Ligne] && $BExclu} { break }
	if {$OnYEst} { lappend LesBonnes $Ligne }
	if {[regexp $B $Ligne]} { break }
    }
    return $LesBonnes
}

proc SqueletteDeProc {} {
    lappend LeSquel "proc ChangeMyName {} {"
    lappend LeSquel "      global RepertoireDuGenome"
    lappend LeSquel "     "
    lappend LeSquel "     "
    lappend LeSquel "}"
    return [join $LeSquel "\n"]
}

proc CreeUneNouvelleProcedure {{Texte ""}} {
    global LesProceduresExistantes

    regsub {^[ \t]*} $Texte "" Texte 

    if {$Texte==""} {
	set Texte [SqueletteDeProc]
    } else {
	if { ! [regexp "^proc " $Texte]} { set Texte "proc $Texte" }
    }
    set Nouveau [EntreTexte $Texte]
    if {$Nouveau==""} { return "" }
    scan $Nouveau "%s %s" P N
    source [Sauve $Nouveau dans [TmpFile ".tcl"]]
    set LesProceduresExistantes [linsert $LesProceduresExistantes 0 $N]
    AfficheLaProc $N
}

proc ModeInteractif {} {
    global RepertoireDuGenome
    global GscopeDir
    set Fin 0
    
    while {!$Fin} {
	if {[gets stdin Ligne]==-1} {
	    set Fin 1
	} else {
	    if {[catch {puts [eval $Ligne]} Message]} {
		puts stderr $Message
	    }
	}
    }
}

proc SplitOrgas Organismes {
    set OrgaJoinCar ":"
    return [split $Organismes $OrgaJoinCar]
}

proc ContenuSubstitueDuFichier {Fichier args} {
    if { $Fichier == "" } {return ""}
    set f [open $Fichier r]
    set Texte [read -nonewline $f]
    close $f
    set I 0
    foreach argument $args {
	set VariableN "(\[^\\\\])\\$${I}(\[^0-9\])" 
	regsub -all {&} $argument {\\&} argument
	regsub -all $VariableN $Texte "\\1$argument\\2" Texte
	incr I
    }
    regsub -all {\\(\$[0-9])} $Texte "\\1" Texte
    return $Texte
}

proc PaqTexte {Label Texte} {
    return "Text: $Label $Texte"
}

proc PaqListe {Label Liste} {
    return "List: $Label [SeriaList $Liste]"
}

proc PaqArray {Label {aArray ""}} {
    if {$aArray==""} { set aArray $Label }
    upvar $aArray Array
    set Liste [array get Array]
    return "Array: $Label [SeriaList $Liste]"
}

proc SeriaList args {
    return "$args"
}

proc ListSeria Texte {
    return [eval list $Texte]
}

proc AffecteLesVariablesDeReponse {Reponse {Level ""}} {
    if {$Level==""} {
	set Level 2
    } else {
	if { ! [regexp {^\#} $Level]} {
	    incr Level
	}
    }
    return [AffecteLesVariablesDeLaListe [split $Reponse "\n"] $Level]
}

proc AffecteLesVariablesDeLaListe {Liste {Level 1}} {
#    JeMeSignale
    foreach Ligne $Liste {
	if { ! [regexp {^(Text|List|Array): } $Ligne]} { continue }
	set Type ""
	set NomDeVariable ""
	scan $Ligne "%s %s" Type NomDeVariable
	if { ! [regexp -nocase {^[a-z_]} $NomDeVariable] } { continue }
	lappend LesVariables $NomDeVariable
	regsub {\(} $NomDeVariable {\\(} NomDeVariable
	regsub {\)} $NomDeVariable {\\)} NomDeVariable
	regsub "^$Type $NomDeVariable " $Ligne "" Ligne
#	puts stderr [string range $Ligne 0 80]
	
	set Commande ""
	switch $Type {
	    "Text:"  {
		set Commande "set $NomDeVariable $Ligne"
	    }
	    "List:"  {
		set Commande "set $NomDeVariable [ListSeria $Ligne]"
	    }
	    "Array:" {
		regsub "^_x_" $NomDeVariable "" NomDeVariable
		set Commande "array set $NomDeVariable [ListSeria $Ligne]"
	    }
	}
	if {[regexp bonjour $Commande]} { Espionne $Commande }
	if {$Commande!=""} { uplevel $Level $Commande }
    }
    return $LesVariables
}

proc EtendAuxPremiersTermes LesTermes {
    if {[llength $LesTermes]<=1} { return $LesTermes }
    if {[lindex $LesTermes 0]!=""} { return $LesTermes }
    set LaSuite [EtendAuxPremiersTermes [lrange $LesTermes 1 end]]
    set Premier [lindex $LaSuite 0]
    return [concat [list $Premier] $LaSuite]
}

proc EtendAuxDerniersTermes LesTermes {
    if {[llength $LesTermes]<=1} { return $LesTermes }
    set Premier [lindex $LesTermes 0]
    foreach Terme $LesTermes {
	if {$Terme==""} { set Terme $Premier }
	lappend LesBonsTermes $Terme
    }
    return $LesBonsTermes
}

proc Teste_LaTraduction {} {
    set Liste [ColorationsPossibles]
    foreach X $Liste T [LaTraduction $Liste english "SansBlanc"] {
	Espionne "$X $T"
    }
    exit
}

proc LaTraduction {Liste {Sortie "english"} {SansBlanc ""}} {
    global GscopeDico

    set SansBlanc [string equal -nocase $SansBlanc "SansBlanc"]

    if { ! [info exists GscopeDico]} {
	foreach FichierDico [glob -nocomplain "[GscopeEtc]/gscope_*.dic"] {
	    if {[file exists $FichierDico]} {
		if {[info exists LesLangues]} { unset LesLangues }
		foreach Ligne [LesLignesDuFichier $FichierDico] {
		    if {[regexp {^[ \t]*\#} $Ligne]} { continue }
		    
		    set LesTermes {}
		    foreach Terme [split $Ligne ":"] {
			regsub -all {^[ \t]+} $Terme "" Terme
			regsub -all {[ \t]+$} $Terme "" Terme
			lappend LesTermes $Terme
		    }
		    if { ! [info exists LesLangues]} {
			set LesLangues $LesTermes
			set NombreDeLangues [llength $LesLangues]
			continue
		    }
		    while {[llength $LesTermes] < $NombreDeLangues} {
			lappend LesTermes "" 
		    }
		    set LesTermes [EtendAuxPremiersTermes $LesTermes]
		    set LesTermes [lrange $LesTermes 0 [expr $NombreDeLangues-1]]
		    set LesTermes [EtendAuxDerniersTermes $LesTermes]
		    
		    foreach Terme $LesTermes {
			foreach Langue $LesLangues TermeTraduit $LesTermes {
			    if {$Terme==""} { continue }
			    if {$SansBlanc} { regsub -all " " $TermeTraduit "_" TermeTraduit }
			    set GscopeDico($Terme:$Langue) $TermeTraduit
			}
		    }
		    
		}

	    }
	}
    }

    foreach Terme $Liste {
	if {[info exists GscopeDico($Terme:$Sortie)]} {
	    lappend LaTraduction [set GscopeDico($Terme:$Sortie)]
	} else {
	    lappend LaTraduction $Terme
	}
    }
    return $LaTraduction
}

proc Traduction {Terme {Sortie "english"}} {
    return [lindex [LaTraduction [list $Terme] $Sortie] 0]
}

proc NombresEntre {D F {Pas 1}} {
    if {$D==$F} { return [list $D] }
    set LesX {}
    for {set X $D} {[expr $Pas*$X <= $Pas*$F]} { set X [expr $X+$Pas]} {
	lappend LesX $X
    }
    return $LesX
}

proc Base10 Texte {
    regsub " " $Texte "" Texte
    if {[regexp "^\-" $Texte]} { set PlusOuMoins "-" } else { set PlusOuMoins "" }
    regsub {^[\-0]*} $Texte "" Texte
    if {$Texte==""} { set Texte 0 }
    return "$PlusOuMoins$Texte"
}

proc Date {{Format ""} {TopChrono ""}} {

    if {$Format==""} { set Format "%Y%m%d%H%M" }

    if {$Format=="Nice_"} {
	set Format "%Y_%m_%d_%H_%M"
    }
    if {$Format=="Nice_H"} {
	set Format "%Y_%m_%d_%Hh%M"
    }
    if {$Format=="Nice"} {
	set Format "%Y/%m/%d %H:%M"
    }

    if {$Format=="Seconds"} { set Format "%Y%m%d%H%M%S" }

    if {$TopChrono==""} { set TopChrono [clock scan now] }
    return [clock format $TopChrono -format $Format]
}

proc LesLigneesUsageUnique {} {
    foreach AppeleeAppelante [LesProceduresUsageUnique] {
	scan $AppeleeAppelante "%s %s" Appelee Appelante
	set AppelanteDe($Appelee) $Appelante
	lappend AppeleePar($Appelante) $Appelee
#	Espionne "set AppelanteDe($Appelee) $Appelante"
#	Espionne "lappend AppeleePar($Appelante) $Appelee > [set AppeleePar($Appelante)]"
	lappend LesUsageUnique $Appelee
    }
    foreach Procedure $LesUsageUnique {
	if {[info exists AppeleePar($Procedure)]} { 
#	    Espionne "j'abandonne $Procedure car appelante de [set AppeleePar($Procedure)]"
	    continue
	}
	set LaLignee {}
	lappend LaLignee $Procedure
	while 1 {
	    if {[info exists AppelanteDe($Procedure)]} {
		set Procedure [set AppelanteDe($Procedure)]
		lappend LaLignee $Procedure
	    } else {
		break
	    }
	}
	Espionne "[llength $LaLignee] [join $LaLignee " "]"
    }
}

proc LesProceduresUsageUnique {} {
    global GscopeDir

    set FichierLesProceduresUsageUnique "$GscopeDir/lesproceduresusageunique"
    if {[file exists $FichierLesProceduresUsageUnique]} {
	return [LesLignesDuFichier $FichierLesProceduresUsageUnique]
    }

    foreach Procedure [LesProceduresExistantes] {
	set LesAppelantes [QuiMAppel $Procedure "LaListeMerci"]
	if {[llength $LesAppelantes] >  1} { continue }
	if {[llength $LesAppelantes] == 0} {
	    set Appelante "PERSONNE"
	} else {
	    set Appelante [lindex $LesAppelantes 0]
	}
	lappend LesProceduresUsageUnique "$Procedure $Appelante"
    }
    SauveLesLignes $LesProceduresUsageUnique dans $FichierLesProceduresUsageUnique
    return $LesProceduresUsageUnique 
}

proc LesProceduresNonAppelantes {} {

    foreach Procedure [LesProceduresExistantes] {
	set LesAppelees [QuiJAppel $Procedure "LaListeMerci"]
	if {$LesAppelees != {}} { continue }
	lappend LesProceduresNonAppelantes $Procedure
    }
    return $LesProceduresNonAppelantes
}

proc AppendAuFichier {Fichier Ligne} {
    set Canal [open $Fichier "a"]
    puts $Canal $Ligne
    close $Canal
    return $Fichier
}

proc Barycentre LesXY {
    set SX 0
    set SY 0
    set N [expr [llength $LesXY]/2]
    if {$N<1} { return {0. 0.} }
    foreach {X Y} $LesXY {
	set SX [expr $SX+$X]
	set SY [expr $SY+$Y]
    }
    return [list [expr 1.0*$SX/$N] [expr 1.0*$SY/$N]]
}

proc Teste_ScanLaListe {} {
    set L {1 2 3 4 5 6 7 }

    puts [ScanLaListe $L a b c]

    puts $a
    puts $b
    puts $c
    exit
}


proc ScanLaListe {Liste args} {
    set i 0
    set Long [llength $Liste]
    foreach aV $args {
	upvar $aV V
	if {$i >= $Long} { break }
	set V [lindex $Liste $i]
	incr i
    }
    return $i
} 

proc FouR {Debut Fin} {
    if {$Debut <= $Fin} {
	return "F"
    } else {
	return "R"
    }
}

proc Teste_Fleche {} {
    set K [UnCanva 600 600]

    Fleche $K 200 100 430 100 -width 50 -outlinewidth 1 -fill "red" -outline "blue" -arrowdirection "both" -flatside "left"
    Fleche $K 200 300 230 300 -width 50 -outlinewidth 1 -outline "green" -arrowdirection "both"
    Fleche $K 200 400 230 400 -width 50 -outlinewidth 1 -fill "" -outline "orange" -arrowdirection "start"
    Fleche $K 200 500 230 500 -width 50 -outlinewidth 1 -fill "red" -outline "grey" -arrowdirection "none"

    $K create oval 10 10 100 200

    MainLeveeSurUnCanva $K

    regsub ".canvas" $K "" w
    Gonfle $w all 1. 1.

    set K [UnCanva 600 600]

    Fleche $K 200 100 230 100 -width 50 -outlinewidth 1 -fill "red" -outline "blue" -arrowdirection "end"
    Fleche $K 200 300 230 300 -width 50 -outlinewidth 1 -fill "red" -outline "blue" -arrowdirection "both"
    Fleche $K 200 400 230 400 -width 50 -outlinewidth 1 -fill "red" -outline "blue" -arrowdirection "start"
    Fleche $K 200 500 230 500 -width 50 -outlinewidth 1 -fill "red" -outline "blue" -arrowdirection "none"

    $K create oval 10 10 100 200

    MainLeveeSurUnCanva $K

    regsub ".canvas" $K "" w
    Gonfle $w all 1. 1.
}

proc Fleche {K DebX DebY FinX FinY args} {

    Wup "Je crains que Fleche demande un canvas avec X et Y de meme nature ... isotropes"
    Wup " => meme facteurs d'echelle sur X et Y."

    set Width 6.
    set Fill "grey"
    set OutLineWidth 1
    set OutLine "black"
    set ArrowWidth 2
    set ArrowDirection "end"
    set FlatSide "none"
    foreach {Option Valeur} $args {
	if {$Valeur==""} { set Valeur "\"\"" }
	switch -regexp -- $Option {
	    "-width$"           { set Width           $Valeur }
	    "-outlinewidth$"    { set OutLineWidth    $Valeur }
	    "-outline$"         { set OutLine         $Valeur }
	    "-fill$"            { set Fill            $Valeur }
	    "-arrowwidth$"      { set ArrowWidth      $Valeur }
	    "-arrowwidthstart$" { set ArrowWidthStart $Valeur }
	    "-arrowwidthend$"   { set ArrowWidthEnd   $Valeur }
	    "-arrowdirection$"  { set ArrowDirection  $Valeur }
	    "-flatside$"        { set FlatSide        $Valeur }
	}
    }
    if { ! [info exists ArrowWidthStart]} {
	if {[regexp "both|start" $ArrowDirection]} {
	    set ArrowWidthStart $ArrowWidth
	} else {
	    set ArrowWidthStart 0
	}
    }
    if { ! [info exists ArrowWidthEnd]} {
	if {[regexp "both|end" $ArrowDirection]} {
	    set ArrowWidthEnd $ArrowWidth
	} else {
	    set ArrowWidthEnd 0
	}
    }

    set w [expr $Width/2.]
    set fStart [expr -$ArrowWidthStart*$w]
    set fEnd   [expr  $ArrowWidthEnd*$w]

    set Long [expr sqrt(($FinX-$DebX)*($FinX-$DebX) + ($FinY-$DebY)*($FinY-$DebY))]
    if {$Long==0} { return "" }

    if {[expr abs($fStart)]            > $Long} { set fStart [expr $Long*$fStart/abs($fStart)] } 
    if {[expr abs($fEnd)]              > $Long} { set fEnd   [expr $Long*$fEnd  /abs($fEnd)] } 
    if {[expr abs($fEnd)+abs($fStart)] > $Long} {
	set fEnd   [expr $Long*$fEnd  /(2*abs($fEnd))  ]
	set fStart [expr $Long*$fStart/(2*abs($fStart))]
	set w [expr abs($fEnd)]
    }

    set AxeX [expr ($FinX-$DebX)/$Long]
    set AxeY [expr ($FinY-$DebY)/$Long]
    set PerX [expr -$AxeY]
    set PerY [expr  $AxeX]
    set MemoPerY $PerY


    set aX [expr $DebX+$w*$PerX]
    set aY [expr $DebY+$w*$PerY]

    set GardeS 0

    Wup "Si on fait une fleche arriere et si ... "
    set sX [expr ($DebX+$FinX)/2]
    set sY [expr ($DebY+$FinY)/2]
    set mX [expr $DebX-$fStart*$AxeX]
    set mY [expr $DebY-$fStart*$AxeY]
    if {[expr ($DebX-$sX)*($DebX-$sX)+($DebY-$sY)*($DebY-$sY)] < \
	    [expr ($DebX-$mX)*($DebX-$mX)+($DebY-$mY)*($DebY-$mY)]} {
	set sX $mX
	set sY $mY
	set GardeS 1
    }

    set f $fEnd
    set mX [expr $FinX-$f*$AxeX]
    set mY [expr $FinY-$f*$AxeY]
    if { ! $GardeS } {
	set sX [expr ($DebX+$FinX)/2]
	set sY [expr ($DebY+$FinY)/2]
	if {[expr ($FinX-$sX)*($FinX-$sX)+($FinY-$sY)*($FinY-$sY)] < \
		[expr ($FinX-$mX)*($FinX-$mX)+($FinY-$mY)*($FinY-$mY)]} {
	    set sX $mX
	    set sY $mY
	    set GardeS 1
	}
    }
    if {[regexp "right$" $FlatSide]} { set PerY 0 }
    lappend Trace [expr $sX+$w*$PerX]
    lappend Trace [expr $sY+$w*$PerY]
    lappend Trace [expr $mX+$w*$PerX]
    lappend Trace [expr $mY+$w*$PerY]
    lappend Trace [expr $mX+$f*$PerX]
    lappend Trace [expr $mY+$f*$PerY]
    lappend Trace $FinX
    lappend Trace $FinY
    set PerY $MemoPerY
    if {[regexp "left$" $FlatSide]} { set PerY 0 }
    lappend Trace [expr $mX-$f*$PerX]
    lappend Trace [expr $mY-$f*$PerY]
    lappend Trace [expr $mX-$w*$PerX]
    lappend Trace [expr $mY-$w*$PerY]
    set f [expr $fStart]
    set w [expr -$w]
    set mX [expr $DebX-$f*$AxeX]
    set mY [expr $DebY-$f*$AxeY]
    if { ! $GardeS} {
	set sX [expr ($DebX+$FinX)/2]
	set sY [expr ($DebY+$FinY)/2]
	if {[expr ($DebX-$sX)*($DebX-$sX)+($DebY-$sY)*($DebY-$sY)] < \
		[expr ($DebX-$mX)*($DebX-$mX)+($DebY-$mY)*($DebY-$mY)]} {
	    set sX $mX
	    set sY $mY
	}
    }
    set PerY $MemoPerY
    if {[regexp "^left" $FlatSide]} { set PerY 0 }
    lappend Trace [expr $sX+$w*$PerX]
    lappend Trace [expr $sY+$w*$PerY]
    lappend Trace [expr $mX+$w*$PerX]
    lappend Trace [expr $mY+$w*$PerY]
    lappend Trace [expr $mX+$f*$PerX]
    lappend Trace [expr $mY+$f*$PerY]
    lappend Trace $DebX
    lappend Trace $DebY
    set PerY $MemoPerY
    if {[regexp "^right" $FlatSide]} { set PerY 0 }
    lappend Trace [expr $mX-$f*$PerX]
    lappend Trace [expr $mY-$f*$PerY]
    lappend Trace [expr $mX-$w*$PerX]
    lappend Trace [expr $mY-$w*$PerY]
    lappend Trace [lindex $Trace 0]
    lappend Trace [lindex $Trace 1]

    return [eval $K create polygon $Trace \
	    -width $OutLineWidth -fill $Fill -outline $OutLine]
}

proc UnCanva {{LargeurMaxi ""} {HauteurMaxi ""} {LargeurVoulue ""} {HauteurVoulue ""} {GonfleAussiY ""} {Titre ""} {AvecMainLevee ""} } {
    if {$LargeurVoulue==""} { set LargeurVoulue 512 }
    if {$HauteurVoulue==""} { set HauteurVoulue [expr ($LargeurVoulue*3)/4] }
    if {$LargeurMaxi==""} { set LargeurMaxi 512 }
    if {$HauteurMaxi==""} { set HauteurMaxi [expr ($LargeurMaxi*3)/4] }
    if {$GonfleAussiY==""} { set GonfleAussiY "GonfleAussiY" }

    global ScrollRectangleOriginal IdScrollRectangle
    global CouleurDuFondDeUnCanva

    if { ! [info exists CouleurDuFondDeUnCanva]} {
	set CouleurDuFondDeUnCanva "white"
    }

    if {[regexp "MainLevee" $AvecMainLevee]} { set AvecMainLevee 1 } else { set AvecMainLevee 0 } 

    if {$GonfleAussiY=="NoY"} {
	set GonfleY 1.0
	set DegonfleY 1.0
    } else {
	set GonfleY "gonfle"
	set DegonfleY "degonfle"
    }

    set w [NomDe canva]
    if {$Titre==""} { set Titre $w } 
    catch {destroy $w}
    toplevel $w
    wm title $w $Titre
    wm iconname $w $Titre

    set CanvaScroMinX 0
    set CanvaScroMinY 0
    set CanvaScroMaxX $LargeurMaxi
    set CanvaScroMaxY $HauteurMaxi

    set K       $w.canvas
    set ScroHor $w.hscroll
    set ScroVer $w.vscroll
    set KShSv   $w.grid
    set Boutons $w.buttons

    frame $Boutons
    pack  $Boutons -side bottom -fill x -pady 2m
    button $Boutons.dismiss -text "Dismiss" -background "red" -command "destroy $w"
      bind $Boutons.dismiss <Control-2> "MainLeveeSurUnCanva $K"
      bind $Boutons.dismiss <Control-3> "FaireLire \[$KShSv configure\]"
      pack $Boutons.dismiss -side left -expand 1
    button $Boutons.postscript -text "Zoom/UnZoom/Reset\nPNG/Postscript/Print\nFull PNG/Postscript/Print" -background "yellow"
    if { ! [string equal -nocase "NoZoom" $GonfleAussiY]} {
      bind $Boutons.postscript <1>       "Gonfle $w all gonfle $GonfleY"
      bind $Boutons.postscript <2>       "Gonfle $w all degonfle $DegonfleY"
      bind $Boutons.postscript <3>       "Gonfle $w all reset reset"
    }
      bind $Boutons.postscript <Shift-1>   "CanvaEnPNG        $K Visible"
      bind $Boutons.postscript <Shift-2>   "CanvaEnPostscript $K Visible AskForFile"
      bind $Boutons.postscript <Shift-3>   "CanvaEnImpression $K Visible"
      bind $Boutons.postscript <Control-1> "CanvaEnPNG        $K OnVeutTout"
      bind $Boutons.postscript <Control-2> "CanvaEnPostscript $K OnVeutTout AskForFile"
      bind $Boutons.postscript <Control-3> "CanvaEnImpression $K OnVeutTout"
      pack $Boutons.postscript -side left -expand 1

    frame $KShSv
    scrollbar $ScroHor -orient horiz -command "$K xview"
    scrollbar $ScroVer               -command "$K yview"
    
    canvas $K \
	    -width  $LargeurVoulue \
	    -height $HauteurVoulue

    $K configure \
	    -scrollregion [list $CanvaScroMinX $CanvaScroMinY $CanvaScroMaxX $CanvaScroMaxY] \
	    -xscrollcommand "$ScroHor set" \
	    -yscrollcommand "$ScroVer set"

    set IdScrollRectangle($K) [$K create rect $CanvaScroMinX $CanvaScroMinY $CanvaScroMaxX $CanvaScroMaxY -tags [list "Cadre"] -outline $CouleurDuFondDeUnCanva]
    set ScrollRectangleOriginal($K) "[$K coords [set IdScrollRectangle($K)]]"


    grid rowconfig    $KShSv 0 -weight 1 -minsize 0
    grid columnconfig $KShSv 0 -weight 1 -minsize 0
    
    grid $K       -in $KShSv -padx 1 -pady 1  -row 0 -column 0  -rowspan 1 -columnspan 1  -sticky nsew
    grid $ScroVer -in $KShSv -padx 1 -pady 1  -row 0 -column 1  -rowspan 1 -columnspan 1  -sticky nsew
    grid $ScroHor -in $KShSv -padx 1 -pady 1  -row 1 -column 0  -rowspan 1 -columnspan 1  -sticky nsew
    pack $KShSv -expand yes -fill both -padx 1 -pady 1
    if {$AvecMainLevee} { MainLeveeSurUnCanva $K }
    return $K
}

proc Gonfle {w Tag {ScaleX "gonfle"} {ScaleY 1.0}} {
    global ScaleCumuleDeGonfle OrigXCumuleDeGonfle OrigYCumuleDeGonfle
    global ScrollRectangleOriginal IdScrollRectangle
    
    Gs "UpdateK"
    
    if {[regexp "rond" $w]} {
	FaireLire "Sorry, the Zoom doesn't work for Rosace."
	return
    }

    set K       $w.canvas
    set ScroHor $w.hscroll
    set ScroVer $w.vscroll

    scan "[$ScroHor get]" "%f %f" g d
    scan "[$ScroVer get]" "%f %f" b h

    set RatioHor [expr ($g + $d)/2]
    set RatioVer [expr ($b + $h)/2]

    scan [$K cget -scrollregion] "%f %f %f %f" xMin yMin xMax yMax
    set CentreHor [expr $xMin + $RatioHor*($xMax-$xMin)]
    set CentreVer [expr $yMin + $RatioVer*($yMax-$yMin)]

    if {[regexp "expo" $K]} {
	set CentreHor 0
	set CentreVer 0
    }


    if {[PourWscope]} {
	set ScaleGonfle 2.0
    } else {
	set ScaleGonfle 1.1
    }
    if { $ScaleY == "gonfle" }   {
	set Scaley $ScaleGonfle
    }
    if { $ScaleY == "degonfle" } {
	set Scaley [expr 1./$ScaleGonfle]
    }
    if { $ScaleX == "gonfle" }   {
	set Scalex $ScaleGonfle
	set Scaley 1.0
    } else {
	set Scalex $ScaleX
	set Scaley 1.0
    }
    if { $ScaleX == "degonfle" } {
	set Scalex [expr 1./$ScaleGonfle]
	set Scaley 1.0
    }
    if { $ScaleY != "1.0"} {
	set Scaley $ScaleY
    }
    if { $ScaleY == "gonfle" }   {
	set Scaley $ScaleGonfle
    }
    if { $ScaleY == "degonfle" } {
	set Scaley [expr 1./$ScaleGonfle]
    }

    if { $ScaleX == "reset" } {
	scan [$K coords [set IdScrollRectangle($K)]] "%f %f %f %f" xMin  yMin  xMax  yMax
	scan [set ScrollRectangleOriginal($K)]       "%f %f %f %f" xMinO yMinO xMaxO yMaxO
	set Scalex [expr ($xMaxO-$xMinO)*1.0/($xMax-$xMin)]
	set Scaley [expr ($yMaxO-$yMinO)*1.0/($yMax-$yMin)]
    }

    $K scale $Tag $CentreHor $CentreVer $Scalex $Scaley
    $K configure -scrollregion [$K coords [set IdScrollRectangle($K)]]

    return $K
}

proc ListeSansDoublon Liste {
    set SansDoublon {}
    foreach Element $Liste {
	if { [info exists DejaVu($Element)] } { continue }
	set DejaVu($Element) 1
	lappend SansDoublon $Element
    }
    return $SansDoublon
}

proc QuiJAppelRecursif Procedure {
    global DejaVuCetteProcedure
    global Tabulation

    if { ! [info exists Tabulation]} { set Tabulation "" }

    set LesAppelees [QuiJAppel $Procedure "LaListeMerci"]
    if {$LesAppelees == {}} { return }
    foreach Appelee $LesAppelees {
	if {[info exists DejaVuCetteProcedure($Appelee)]} { continue }
	Espionne "$Tabulation $Appelee"
	set DejaVuCetteProcedure($Appelee) 1
	set Tabulation "$Tabulation    "
	QuiJAppelRecursif $Appelee
	set Tabulation [string range $Tabulation 4 end]
    } 
}

proc NousAllonsAuBoulot {{RepTrav ""}} {
    global MemorisePWD

    if {$RepTrav==""} {
	set RepTrav [RepertoireDeTravail]
    }

    set PWD [pwd]
    set MemorisePWD $PWD
    cd $RepTrav
    return $RepTrav
}

proc OnRevientDuBoulot {} {
    global MemorisePWD
    cd $MemorisePWD
}

proc RetourneLaListe Liste {

    if {[llength $Liste] < 2} { return $Liste }

    set X [lindex $Liste 0]
    set ResteRetourne [RetourneLaListe [lrange $Liste 1 end]]
    return [lappend ResteRetourne $X]
}

proc ButineEtAjoute Texte {
    set NouveauTexte [ContenuDuFichier [ButineArborescence All]]
    if { $NouveauTexte != "" } {
	$Texte insert end $NouveauTexte
    }
}

proc ButineEtRemplace Texte {
    set NouveauTexte [ContenuDuFichier [ButineArborescence All]]
    if { $NouveauTexte != "" } {
	$Texte delete 0.0 end
	$Texte insert end $NouveauTexte
    }
}

proc ButineArborescence {{Type "All"} {RepertoireEtFichier ""}} {
    global RepertoireInitialDeButine
    global FichierInitialDeButine

    if {[regexp {/$} $RepertoireEtFichier]} {
	regsub {/$} $RepertoireEtFichier "" Rep
	set Fic ""
    } else {
	set Rep [file dirname $RepertoireEtFichier]
	set Fic [file tail $RepertoireEtFichier]
    }
    if {$Rep!=""} {
	set RepertoireInitialDeButine $Rep
    }
    if {$Fic!=""} {
	set FichierInitialDeButine $Fic
    }

    if { ! [info exists RepertoireInitialDeButine]} { set RepertoireInitialDeButine [pwd] } 
    if { ! [info exists FichierInitialDeButine]}    { set FichierInitialDeButine "" } 


    set Types(All) {
	{{All files}            *  }
    }
    
    set Types(MSF) {
	{{Alignment output}  {.msf}}
	{{All files}            *  }
    }
    
    set Types(Blastp) {
	{{Blast output}   {.blastp}}
	{{All files}            *  }
    }
    
    set Types(FOF) {
	{{File Of Filenames} {.fof}}
	{{All files}            *  }
    }
    
    set Types(ps) {
	{{Postcript file} {.ps}}
	{{All files}            *  }
    }
    
    set Types(Sequence) {
	{{All files}            *  }
	{{Raw}               {.seq}}
	{{Fasta}             {.tfa}}
	{{GCG}               {.ged}}
    }

    set NomDeFichier [tk_getOpenFile -title "Fichier a ouvrir" \
	    -initialdir $RepertoireInitialDeButine \
	    -initialfile $FichierInitialDeButine \
	    -defaultextension "" \
	    -filetypes $Types($Type)]
    if { $NomDeFichier == "" } { return ""}
    set RepertoireInitialDeButine [file dirname $NomDeFichier]    
    return $NomDeFichier

}

proc RepertoireDeTravail {{JunkDir ""}} {
    global RepertoireDeTravail
    global env

    if {[info exists RepertoireDeTravail]} { return $RepertoireDeTravail }

    if {$JunkDir == ""} {
	if {[info exists env(HOME)]} {
	    set JunkDir "$env(HOME)/junkdir"
	} else {
	    set JunkDir "/tmp/tmp[pid]"
	}
    }
    if {[file isdirectory $JunkDir]} {
	set RepertoireDeTravail $JunkDir
	return $RepertoireDeTravail
    }
    if {[OuiOuNon "Can I create a Working directory\n$JunkDir\n ?"]} {
	File mkdir $JunkDir
	set RepertoireDeTravail $JunkDir
	return $RepertoireDeTravail
    }
    if {[OuiOuNon "Do You want to choose an other Working directory ?"]} {
	set AutreJunkDir [Entre [pwd]]
    } else {
	set AutreJunkDir ""
    }
    set RepertoireDeTravail [RepertoireDeTravail $AutreJunkDir]
    return $RepertoireDeTravail
}

proc CanvaEnImpression {K CeQuOnVeut} {
    set NomDuFichierPS [CanvaEnPostscript $K $CeQuOnVeut "[RepertoireDeTravail]/tmp[NomDe ""].ps"]
    if {$NomDuFichierPS==""} { return }
    return [ImprimeLeFichier $NomDuFichierPS]
}

proc CanvaEnPostscript {K {CeQuOnVeut "Visible"} {QuoiRetourner "RetourOrdres"} {Anchor "center"}} {
    Gs "File"
    
    
    if { $QuoiRetourner == "AskForFile" || $QuoiRetourner=="" } {
	set NomDuFichierPS [FichierPourSaveAs]
	if {$NomDuFichierPS==""} { return "" }
    } else {
	set NomDuFichierPS $QuoiRetourner
    }

    set Largeur [lindex [$K configure -width] 4]
    set Hauteur [lindex [$K configure -height] 4]
    set PortraitOuLandscape [expr $Largeur > $Hauteur]

    if {[regexp "rond" $K]} {
	set OptionWH "-width 768 -x 0"
    } else {
	if {$CeQuOnVeut=="Visible"} {
	    set OptionWH ""
	} else {
#	    scan [lindex [$K configure -scrollregion] 4] "%f %f %f %f" minX minY maxX maxY
	    scan [$K bbox all] "%d %d %d %d" minX minY maxX maxY
	    set OptionWH "-width $maxX -height $maxY"
	}
    }
    if {$QuoiRetourner=="RetourOrdres"} {
	set Retour [eval $K postscript $OptionWH -rotate $PortraitOuLandscape]
    } else {
	eval $K postscript -file $NomDuFichierPS $OptionWH -rotate $PortraitOuLandscape
	set Retour $NomDuFichierPS
    }
    return $Retour
}

proc CanvaEnPostscriptPourGif {K {CeQuOnVeut "Visible"}} {
    return [CanvaEnPostscript $K $CeQuOnVeut "RetourOrdres"]
}

proc OldCanvaEnPostscriptPourGif {K {CeQuOnVeut "Visible"}} {
    set Largeur [lindex [$K configure -width] 4]
    set Hauteur [lindex [$K configure -height] 4]
    set PortraitOuLandscape [expr $Largeur > $Hauteur]
    
    set lePostscript ""
    if {[regexp "rond" $K]} {
	set lePostscript [$K postscript -width 768 -x 0 -rotate $PortraitOuLandscape]
    } else {
	if {$CeQuOnVeut=="Visible"} {
	    set lePostscript [$K postscript -rotate $PortraitOuLandscape]
	} else {
	    Espionne [$K configure -scrollregion]
	    scan [lindex [$K configure -scrollregion] 4] "%f %f %f %f" minX minY maxX maxY
	    Espionne "$minX $minY $maxX $maxY"
	    set lePostscript [$K postscript -width $maxX -height $maxY -rotate $PortraitOuLandscape]
	}
    }
    return $lePostscript
}

proc OuiOuNonMemo {Message {ReponseParDefaut ""} {Value 1}} {
    global OuiOuNonMemo

    if {$Message=="UnsetAllPlease"} {
	if {[info exists OuiOuNonMemo]} { unset OuiOuNonMemo }
	return 1
    }
    if {$ReponseParDefaut=="SetItPleaseTo"} {
	if {[info exists OuiOuNonMemo($Message)]} {
	    set OldRep [set OuiOuNonMemo($Message)]
	} else {
	    set OldRep -1
	}
	set OuiOuNonMemo($Message) $Value
	return $OldRep
    }

    if {$ReponseParDefaut=="UnsetItPlease"} {
	if { ! [info exists OuiOuNonMemo($Message)]} { return -1 }
	set OldRep [set OuiOuNonMemo($Message)]
	unset OuiOuNonMemo($Message)
	return $OldRep
    }

    if {[info exists OuiOuNonMemo($Message)]} { return [set OuiOuNonMemo($Message)] }

    set Reponse [OuiOuNon $Message $ReponseParDefaut]
    set OuiOuNonMemo($Message) $Reponse
    return $Reponse
}

proc OuiOuNonTempo {Message {ReponseParDefaut ""} {Tempo ""}} {
    global OuiOuNonToujoursParDefaut
    
    Gs "Rien"

    if {$ReponseParDefaut==""} { set ReponseParDefaut 1 }

    if {$ReponseParDefaut} {
	set IndexReponse 0
    } else {
	set IndexReponse 1
    }

    if {[info exists OuiOuNonToujoursParDefaut] && $OuiOuNonToujoursParDefaut} { return $ReponseParDefaut }
    
    set Demandeur ""
    catch {set Demandeur [PreFixe]}
    if {$Demandeur!=""} { set Demandeur "(for $Demandeur)" }


    set R [AfficheVariable "$Demandeur ... please answer within 10 seconds.\n$Message" AvecRetour OuiOuNonTempo]

    if {$R==2} {
	set L [info level]
	set CalledBy ""
	for {set L [info level]} {$L>0} {incr L -1} {
	    lappend LeTexte "$CalledBy [info level $L]"
	    set CalledBy "called by  "
	}
	FaireLire [join $LeTexte "\n"]
	set Reponse [OuiOuNon $Message $ReponseParDefaut]
    } else {
	set Reponse [expr 1-$R]
    }
    destroy .ouiounon
    return $Reponse
}

proc OuiOuNon {Message {ReponseParDefaut ""}} {
    global OuiOuNonToujoursParDefaut
    
    Gs "Rien"

    if {$ReponseParDefaut==""} { set ReponseParDefaut 1 }

    if {$ReponseParDefaut} {
	set IndexReponse 0
    } else {
	set IndexReponse 1
    }

    if {[info exists OuiOuNonToujoursParDefaut] && $OuiOuNonToujoursParDefaut} { return $ReponseParDefaut }
    
    set Demandeur ""
    catch {set Demandeur [PreFixe]}
    if {$Demandeur!=""} { set Demandeur "(for $Demandeur)" }

    after idle {.ouiounon.msg configure -wraplength 10i -foreground white -background red}
    set R [tk_dialog .ouiounon "$Demandeur Please press Yes or No" "$Message" {} $IndexReponse "Yes" "No" "?"]
    if {$R==2} {
	set L [info level]
	set CalledBy ""
	for {set L [info level]} {$L>=0} {incr L -1} {
	    lappend LeTexte "$CalledBy [info level $L]"
	    set CalledBy "called by  "
	}
	FaireLire [join $LeTexte "\n"]
	set Reponse [OuiOuNon $Message $ReponseParDefaut]
    } else {
	set Reponse [expr 1-$R]
    }
    destroy .ouiounon
    return $Reponse
}

proc TestWarne {} {

    global WarneEnPuts 
    set WarneEnPuts 0
    set WarneEnPuts 0
    
    Warne salut
    Warne "Comment ca va ?" 

}

proc Warne Texte {
    global WarneWindow
    global WarneEnPuts
    global WarneNon

    if {[info exists WarneNon] && $WarneNon} { return "" }

    if { ! [info exists WarneEnPuts]} { set WarneEnPuts 1 }

    if { [info exists WarneEnPuts] && $WarneEnPuts } { 
	puts $Texte
	return $Texte
    }

#    return ""
    Wup "La suite est a revoir si Warne dans fenetre"

    if { ! [info exists WarneWindow] || ! [winfo exists $WarneWindow]} {
	set WarneWindow [AfficheVariable "Warnings..." "" "Warnings"]
	wm iconify $WarneWindow 
    }

    $WarneWindow.frame.list insert end $Texte
    $WarneWindow.frame.list yview end
    update
    return $WarneWindow
}

proc Patience Commande {
    set w [NomDe fenetre]
    toplevel $w
    wm title $w "Patience ..."
    wm iconname $w "Patience ..."

    label $w.msg -text "$Commande \n Ca bosse ... Il faut attendre. "
    pack  $w.msg

    update

    return $w
}

proc JeMeSignale {{Etat ""}} {
    global FenetreDePatience NiveauFenetreDePatience
    global JeMeSignaleInactif

    if { [info exists JeMeSignaleInactif] && $JeMeSignaleInactif } { return }


    if { ! [info exists NiveauFenetreDePatience] } {
	set NiveauFenetreDePatience 0
    }

    set Commande "\[[info level -1]\]"
    if { $Etat == "Get" } { return $Commande }
    set CommandeComplete "$Commande $Etat"

    Warne $CommandeComplete

    set Commande [lindex [split $CommandeComplete " "] 0]


    if { $Etat == "Patience" } {
	incr NiveauFenetreDePatience 
	set FenetreDePatience($NiveauFenetreDePatience) [Patience $Commande]
	return [set FenetreDePatience($NiveauFenetreDePatience)]
    }

    if { $Etat == "FinPatience" } { 
	Warne [set FenetreDePatience($NiveauFenetreDePatience)]
	destroy [set FenetreDePatience($NiveauFenetreDePatience)]
	incr NiveauFenetreDePatience -1
	update
	return ""
    }

    return ""
}

proc TriDeFichiers {A B} {
    set DA [file dirname $A]
    set DB [file dirname $B]
    if {$DA<$DB} { return -1 }  
    if {$DA>$DB} { return  1 }  
    return [string compare [file tail $A] [file tail $B]]
}

proc ReSource {{Fichier ""}} {
    global ReSource

    if {$Fichier=="Precedent"} {
	if {[info exists ReSource]} {
	    set Fichier $ReSource
	} else {
	    set Fichier ""
	}
    }

    if {$Fichier==""} {
	set LesSourcesTcl {}
	foreach F [lsort -command TriDeFichiers [LesSourcesDuProgramme "Absolute"]] {
	    if { ! [regexp ".tcl$" $F]} { continue } 
	    lappend LesSourcesTcl $F
	}
	set Fichier [ChoixParmi $LesSourcesTcl]
	if {$Fichier==""} { set ReSource "" ; return "" }
    }
    if { ! [file exists $Fichier]} {
	FaireLire "$Fichier doesn't exist"
	set ReSource "" 
	return ""
    }
    set ReSource $Fichier
    source $Fichier
    return $Fichier
}

proc DemandeEtExecute {{Commande ""}} {
    global RepertoireDuGenome
    global GscopeDir

    FaireLire "Please write your instruction on the interactiv terminal window"

    set Commande ""
    while {1} {
	puts -nonewline stdout "Gscope_: "
	flush stdout
	set Ligne [gets stdin]
	if {$Commande==""} {
	    set Commande $Ligne
	} else {
	    append Commande "\n$Ligne"
	}
	if {[info complete $Commande]} {
	    if {[regexp {^ *(return|stop) *$} $Commande]} {
		puts "Thanks for discussion. I close interaction. Bye bye !"
		return
	    }
	    if {[catch {eval $Commande} Message]} {
		puts $Message
	    }
	    set Commande ""
	}
    }
}

proc CompleteEtExecute Commande {
    regsub { +\{ *$} $Commande "" Commande
    Espionne ">$Commande<"
    if {[regexp -nocase {[a-z0-9_]+ +\{\}} $Commande]} {
	scan $Commande "%s" Complete
    } else {
	set Complete [Entre $Commande]
    }
    if {$Complete==""} { return "" }
    return [Execute $Complete]    
}

proc Execute Commande {
    return [eval $Commande]    
}

proc Entre {{Defo ""}} {
    global RetourEntre
    
    global EntreToujoursDefaut
    
    if {[info exists EntreToujoursDefaut] && $EntreToujoursDefaut} { return $Defo } 
    
    set w [NomDe fenetre]
    toplevel $w
    wm title $w "To validate   <return>  or  <Button-3>"
    wm iconname $w ""
    wm geometry $w +300+300
    
    entry    $w.e -width 80 -borderwidth 10 -background red -foreground white -font {Courier 14}
    if { $Defo != "" } { $w.e  insert 0 $Defo }
    pack     $w.e -expand 1 -fill x
    focus    $w.e
    bind     $w.e <Button-3> "set RetourEntre($w) \[$w.e get\]"
    bind     $w.e <Return>   "set RetourEntre($w) \[$w.e get\]"
    tkwait variable RetourEntre($w)
    destroy $w
    set Retour [set RetourEntre($w)]
    unset RetourEntre($w)
    return $Retour
}

proc EditeEtCreeFichier {{Fichier ""} {Defo ""} {Ask ""}} {
    set Texte [EntreTexte $Defo]
    if {$Texte==""} { return "" }
    if {$Texte=="\n"} {
	if {[OuiOuNon "Do I cancel EditeEtCreeFichier ?"]} { return "" }
	if {[OuiOuNon "Do I save as an empty string (without \\n) ?"]} { set Texte "" }
    }
    if {$Fichier=="" || $Ask!=""} { set Fichier [FichierPourSaveAs $Fichier] }
    if {$Fichier==""} { return "" }
    return [Sauve $Texte dans $Fichier]
}

proc EntreTexte {{Defo ""} {BoutonsEnPlus ""}} {
    global RetourEntreTexte
    global FenetreInfoOuverte
    global PolicePourEntreTexte
    
    set w [NomDe fenetre]
    toplevel $w
    wm title $w "You can edit this text ... "
    wm iconname $w "Edit"
    
    set LesLignesDuTexte [split $Defo "\n"]
    set PremiereLigne [lindex $LesLignesDuTexte 0]
    if {[regexp {^Nom\: } $PremiereLigne]} {
	scan $PremiereLigne "%s %s" Bidon Nom
	set FenetreInfoOuverte($Nom) $w
    }
    
    set Hauteur [Mini 10 [Maxi 30 [llength $LesLignesDuTexte]]]
    set Largeur 80
    foreach Ligne $LesLignesDuTexte {
	set Largeur [Maxi $Largeur [string length $Ligne]]
    }
    set Largeur [Mini $Largeur 180]

    

    set Police 12
    if {[info exists PolicePourEntretexte]} { set Police $PolicePourEntreTexte }
    text  $w.text -wrap none -relief sunken -bd 2 \
	    -font [list Courier $Police] \
	    -xscrollcommand "$w.xscroll set" \
	    -yscrollcommand "$w.yscroll set" \
	    -width $Largeur -height $Hauteur
          $w.text insert 0.0 $Defo
    focus $w.text
    
    frame  $w.buttons
    pack   $w.buttons -side bottom -fill x -pady 2m
    
    button $w.buttons.dismiss -background red -text "Dismiss"
      bind $w.buttons.dismiss <1> "set RetourEntreTexte($w) \"\""
      pack $w.buttons.dismiss -side left -expand 1
    button $w.buttons.saveas -text "Save All/Sel."
      bind $w.buttons.saveas <1> "SaveAs \[$w.text get 1.0 end\]"
      bind $w.buttons.saveas <2> "SaveAs \[$w.text get sel.first sel.last\]"
      pack $w.buttons.saveas -side left -expand 1
    button $w.buttons.aspect -text "Font"
      bind $w.buttons.aspect <1> "PolicePourEntreTexte Ask $w"
      pack $w.buttons.aspect -side left -expand 1
    button $w.buttons.browse -text "Replace/Append/Choose\n(with other file)"
      bind $w.buttons.browse <1> "ButineEtRemplace $w.text"
      bind $w.buttons.browse <2> "ButineEtAjoute $w.text"
      bind $w.buttons.browse <3> "ChoisiEtAjouteChampsInfo $w.text"
      pack $w.buttons.browse -side left -expand 1
    button $w.buttons.accept -text "Accept All/Sel." -background green -foreground black
      bind $w.buttons.accept <1> "set RetourEntreTexte($w) \[$w.text get 1.0 end\]"
      bind $w.buttons.accept <2> "set RetourEntreTexte($w) \[$w.text get sel.first sel.last\]"
      pack $w.buttons.accept -side left -expand 1
    if {$BoutonsEnPlus!=""} {
	set I 0
	foreach {T C} $BoutonsEnPlus { 
	    incr I
	    button $w.buttons.plus$I -text $T -background orange -foreground black
	      bind $w.buttons.plus$I <1> $C
	      pack $w.buttons.plus$I -side left -expand 1
	}
    }
    
    scrollbar $w.xscroll -command "$w.text xview" -orient "horizontal"
         pack $w.xscroll -side bottom -fill x
    scrollbar $w.yscroll -command "$w.text yview"
         pack $w.yscroll -side right -fill y
    
    pack $w.text -expand yes -fill both
    
    tkwait variable RetourEntreTexte($w)
    if {[info exists RetourEntreTexte($w)]} {
	set Retour [set RetourEntreTexte($w)]
	unset RetourEntreTexte($w)
    } else {
	set Retour ""
    }
    destroy $w
    regsub {\n$} $Retour "" Retour
    return $Retour
}

proc FaireLire Message {
    global FaireLireNon

    if {[info exists FaireLireNon] && $FaireLireNon} { return }
    if {[string length $Message] > 1000} {
	set Message "[string range $Message 0 499]\n ... \n ... [string range $Message end-499 end]"
    }
    after idle {.fairelire.msg configure -wraplength 10i -foreground white -background red}
    tk_dialog .fairelire "Please press OK" "$Message" {} 0 Acknowledge
    catch {destroy .fairelire}
    update
}

proc BoutonneLaFenetre {Fenetre Texte {Commande ""}} {
    set NdB [NomDe bouton]
    if {$Commande==""} {
	button $Fenetre.buttons$NdB -text $Texte
    } else {
	button $Fenetre.buttons$NdB -text $Texte -command $Commande
    }
    pack $Fenetre.buttons$NdB -side right -expand 1
    return "$Fenetre.buttons$NdB"
}

proc NomDe Machin {
    global NumeroDe
    if { ! [info exists NumeroDe] } {set NumeroDe 0000}
    incr NumeroDe
    return ".$Machin$NumeroDe"
}

proc TmpFile {{Racine ""} {Rep ""} {Sep ""}} {
    global TmpFileNumber
    
    if {$Rep=="envTEMP"} {
	global env
	if {[info exists env(TEMP)]} {
	    set Rep [set env(TEMP)]
	} else {
	    set Rep ""
	}
    }
    if {$Sep==""} { set Sep "." }
    if {$Rep==""} { set Rep [RepertoireDeTravail] }
    if { ! [info exists TmpFileNumber]} { set TmpFileNumber 0 }
    if {$Racine==""} { set Racine "tmp" }
    set Pid [pid]
    incr TmpFileNumber
    set TmpFileName "$Rep/$Racine$Sep$Pid$Sep$TmpFileNumber"
    return $TmpFileName
} 

proc Focalise {Fenetre {Action ""}} {
    global MotFocalise
    global PositionFocalise

    if {$Action=="ask"} { if {[info exists MotFocalise]} { unset MotFocalise } }
    if {$Action=="top"} { set PositionFocalise -1 }

    if { ! [info exists MotFocalise] } { 
	set MotFocalise [Entre ""]
	if {$MotFocalise==""} { return }
	set PositionFocalise -1
    }

    incr PositionFocalise

    set FenetreListBox $Fenetre.frame.list
    foreach Ligne [$FenetreListBox get $PositionFocalise end] {
	if { [regexp -nocase $MotFocalise $Ligne] } {
	    $FenetreListBox yview $PositionFocalise
	    $FenetreListBox selection set $PositionFocalise
	    return
	}
	incr PositionFocalise
    }
    set PositionFocalise -1
}

proc EraseLeCanva {K {ListeDeTags ""} {Demander ""}} {
    if {$Demander==""} { set Demander 0 }
    if {$ListeDeTags==""} {
	set ListeDeTags [list "all"]
	if {[OuiOuNon "Do I erase ALL widgets ?"]} {
	    set Demander 0
	} elseif {[OuiOuNon "Do I ask for each widget ?"]} { 
	    set Demander 1
	}
    }

    set IdCadre [$K find withtag "Cadre"]

    foreach Tag $ListeDeTags {
	set LesIds [$K find withtag $Tag]
	foreach Id $LesIds {
	    if {$Id==$IdCadre} { continue }
	    set Type [$K type $Id]
	    if {$Demander && ! [OuiOuNon "Erase $Type ?"]} { 
		continue
	    }
	    $K delete $Id
	}
    }
    return $K
}

proc RestaureLeCanva {K {ListeOuFichier {}}} {

    if {[llength $ListeOuFichier] > 1} {
	set LesCommandesDeCreation $ListeOuFichier
    } else {
	if {[llength $ListeOuFichier] == 1} {
	    set Fichier $ListeOuFichier
	} else {
	    set Fichier [ButineArborescence]
	    if {$Fichier == ""} { return "" }
	}
	set LesCommandesDeCreation [LesLignesDuFichier $Fichier]
    }
    foreach CommandeDeCreation $LesCommandesDeCreation {
	eval $K $CommandeDeCreation
    }
    return $K
}

proc SauveLeCanva {K ListeDeTags {Fichier ""}} {
    Wup "Retourne le nom du fichier de sauvegarde. String vide si rien n'est sauve."

    set LesCommandesDeCreation {}
    foreach Tag $ListeDeTags {
	set LesIds [$K find withtag $Tag]
	foreach Id $LesIds {
	    if {[info exists DejaVu($Id]} { continue }
	    set DejaVu($Id) 1
	    set    CommandeDeCreation "create [$K type $Id] [join [$K coords $Id] " "] "
	    Espionne "[$K itemconfigure $Id]"
	    foreach Option [$K itemconfigure $Id] {
		set NomDOption [lindex $Option 0]
		set Valeur     [lindex $Option end]
		if {$Valeur == ""} { set Valeur "\{\}" }
		if {[regexp " " $Valeur]} { set Valeur "\{$Valeur\}" }
		append CommandeDeCreation " $NomDOption $Valeur"
	    }
	    lappend LesCommandesDeCreation $CommandeDeCreation
	}
    }
    if {$Fichier != ""} {
	set Fichier $ListeOuFichier
    } else {
	set Fichier [FichierPourSaveAs]
	if {$Fichier == ""} { return "" }
    }
    return [SauveLesLignes $LesCommandesDeCreation dans $Fichier]
}

proc Mini {a b} {
    if {$a<$b} { return $a } else { return $b }
}

proc Maxi {a b} {
    if {$a<$b} { return $b } else { return $a }
}

proc Wup Texte {
 
}

proc Gs TypeDeRetour {
    # Differents types de retour :
    # Rien
    # Text
    # Frame
}

proc File {Commande args} {
    Wup "Copyright 1999 Raymond Ripp"
    Wup "Tcl8.2 accepts much more 'file' commands then earlier versions"
    Wup " I wrote 'File' to try to run with these old versions"

    if {[info tclversion] >= 8.2} {
	return [eval file $Commande $args]
    } else {
	set Args $args
	if {[regexp -nocase "win" $tcl_platform(os)]} {
	    if {[lindex $Args 0]=="-force"} {
		set Args [lreplace $args 0 0 "/Y"]
	    }
	    switch $Commande {
		"delete" { set Commande "erase" }
	    }
	} else {
	    if {[lindex $Args 0]=="-force"} {
		set Args [lreplace $args 0 0 "-f"]
	    }
	    switch $Commande {
		"delete" { set Commande "rm" }
		"rename" { set Commande "mv" }
		"copy"   { set Commande "cp" }
	    }
	}
	return [eval exec $Commande $Args]
    }
}

proc ComplementString S {
    regsub -all -- "A" $S "Z" S 
    regsub -all -- "T" $S "A" S
    regsub -all -- "Z" $S "T" S 
    regsub -all -- "G" $S "Z" S 
    regsub -all -- "C" $S "G" S
    regsub -all -- "Z" $S "C" S

    regsub -all -- "a" $S "z" S 
    regsub -all -- "t" $S "a" S
    regsub -all -- "z" $S "t" S 
    regsub -all -- "g" $S "z" S 
    regsub -all -- "c" $S "g" S
    regsub -all -- "z" $S "c" S
    return $S
}

proc ReverseString S {
    set Reverse ""
    for {set i [expr [string length $S]-1]} {$i>=0} {incr i -1} {
	append Reverse [string range $S $i $i]
    }
    return $Reverse
}

proc PremiereLigneDuFichier Fichier {
    if { $Fichier == "" } {return ""}
    set f [open $Fichier r]
    if {[gets $f Ligne]<0} { set Ligne "" } 
    close $f
    return $Ligne
}

proc LesPremieresLignesDuFichier {Fichier n} {
    if { $Fichier == "" } {return {}}
    if {$n<1} { return {}}
    set f [open $Fichier r]
    set LesLignes {}
    while {[gets $f Ligne]>=0} {
	lappend LesLignes $Ligne
	if { ! [incr n -1]} { break }
    }
    close $f
    return $LesLignes
}

proc IemeLigneDuFichier {Fichier i} {
    return [lindex [LesLignesDuFichier $Fichier] [incr i -1]]
}

proc LesLignesIaJDuFichier {Fichier i j} {
    return [lrange [LesPremieresLignesDuFichier $Fichier $j] [incr i -1] end]
}

proc CompareLesFloatsEnDebut {TexteA TexteB} {

    scan $TexteA "%f" a
    scan $TexteB "%f" b

    if {[expr double($a) <  double($b)]} { return -1}
    if {[expr double($a) == double($b)]} { return  0}
    if {[expr double($a)  > double($b)]} { return  1}
}

proc CompareLesIntegersEnDebut {TexteA TexteB} {

    scan $TexteA "%d" a
    scan $TexteB "%d" b

    if {[expr $a <  $b]} { return -1}
    if {[expr $a == $b]} { return  0}
    if {[expr $a  > $b]} { return  1}
}

proc CompareLesFloats {TexteA TexteB} {

    if { [llength [split [string trim $TexteA] " "]] > 1 } {
	scan $TexteA "%s %f" A a
    } else {
	scan $TexteA "%f" a
    }  
    if { [llength [split [string trim $TexteB] " "]] > 1 } {
	scan $TexteB "%s %f" B b
    } else {
	scan $TexteB "%f" b
    }  

    if {[expr double($a) <  double($b)]} { return -1}
    if {[expr double($a) == double($b)]} { return  0}
    if {[expr double($a)  > double($b)]} { return  1}
}

proc CompareLesIntegers {TexteA TexteB} {

    if { [llength [split [string trim $TexteA] " "]] > 1 } {
	scan $TexteA "%s %f" A a
    } else {
	scan $TexteA "%f" a
    }  
    if { [llength [split [string trim $TexteB] " "]] > 1 } {
	scan $TexteB "%s %f" B b
    } else {
	scan $TexteB "%f" b
    }  

    if {[expr $a <  $b]} { return -1}
    if {[expr $a == $b]} { return  0}
    if {[expr $a  > $b]} { return  1}
}

proc CompareSansPremierChamp {TexteA TexteB} {

    set iB [string first " " $TexteA]
    if {$iB < 0} {
	set a ""
    } else {
	set a [string trimleft [string range $TexteA $iB end]]
    }

    set iB [string first " " $TexteB]
    if {$iB < 0} {
	set b ""
    } else {
	set b [string trimleft [string range $TexteB $iB end]]
    }

    return [string compare $a $b]
}

proc CompareLeTroisiemeChamp {LigneA LigneB} {

    scan $LigneA "%s %s %f" A AA a
    scan $LigneB "%s %s %f" B BB b

    if {[expr $a <  $b]} { return -1}
    if {[expr $a == $b]} { return  0}
    if {[expr $a  > $b]} { return  1}
}

proc CompareLesMilieux {LigneA LigneB} {

    scan $LigneA "%s %d %d" A DA FA
    scan $LigneB "%s %d %d" B DB FB

    set a [expr ($DA+$FA)/2]
    set b [expr ($DB+$FB)/2]

    if {[expr $a <  $b]} { return -1}
    if {[expr $a == $b]} { return  0}
    if {[expr $a  > $b]} { return  1}
}

proc EditAndShow {Texte {FichierPourSave ""} {Maniere ""}} {
    return [AfficheVariable [EntreTexte $Texte] "AvecFormate$Maniere" $FichierPourSave]
}

proc IntegerEnFin {de Texte} {
    return [ValeurEnFin de $Texte "%d"]
}

proc FloatEnFin {de Texte} {
    return [ValeurEnFin de $Texte "%f"]
}

proc ValeurEnFin {de Texte Format} {
    set BonTexte [string trim $Texte]
    set iZone [expr [string last " " $BonTexte]+1]
    scan [string range $BonTexte $iZone end] "$Format" Valeur
    return $Valeur
}

proc ValeurApres {Champ dans Texte Format} {
    set iZone [string first $Champ $Texte]
    if {$iZone<0} { return "" }
    incr iZone [string length $Champ]
    
    if { $Format == "ExposantEventuellementMalFoutu" } {
	set sPN [string trim [string range $Texte $iZone end]]
	regsub {^[eE]} $sPN "1.0e" sPN
	scan $sPN "%f" PN
	if {[catch { expr $PN > 0.001 } ]} {
	    Warne "Oh le vilain $sPN trop petit, je prends 1.0E-200"
	    set PN 1.0E-200
	}
	set Valeur $PN
    } else {
	if {$iZone<0} {return ""}
	set Valeur ""
	scan [string range $Texte $iZone end] "$Format" Valeur
    }
    return $Valeur
}

proc StringSuivant {Champ dans Texte} {
    set i [string first $Champ $Texte]
    if {$i==-1} { return "" }
    incr i [string length $Champ]
    return [string range $Texte $i end]
}

proc StringApres {Champ dans Texte} {
    return [ValeurApres $Champ dans $Texte "%s"]
}

proc IntegerApres {Champ dans Texte} {
    return [ValeurApres $Champ dans $Texte "%d"]
}

proc FloatApres {Champ dans Texte} {
    return [ValeurApres $Champ dans $Texte "%f"]
}

proc LConcat {aListe ListeB} {
    upvar $aListe Liste
    if { ! [info exists Liste]} { set Liste {} }
    set Liste [concat $Liste $ListeB]
    return $Liste
}

proc EspionneL Liste {
    Espionne [join $Liste "\n"]
}

proc Espionne Texte {
    global EspionneNon

    regsub "/home/arnaud/Seqdir/trans/p62/Oligos/" $Texte "" Texte

    if {[info exists EspionneNon] && $EspionneNon} { return }

    puts $Texte
}

proc ContenuDuFichier {{Fichier ""}} {
    if { $Fichier == "" } {return ""}
    set f [open $Fichier r]
    set Texte [read -nonewline $f]
    close $f
    return $Texte
}

proc LesLignesDuFichier {{Fichier ""}} {
    return [split [ContenuDuFichier $Fichier] "\n"]
}

proc Nuance3x8 {Amour {UnPeu 0.1} {Passion 0.6}} {
    set h [expr $UnPeu + ($Passion-$UnPeu)*$Amour]
    set rgb [hsbToRgb $h 1. 1.]
    set r [lindex $rgb 0]
    set g [lindex $rgb 1]
    set b [lindex $rgb 2]
    set color [format "%d %d %d" [expr $r/256] [expr $g/256] [expr $b/256]]
    return $color
}

proc Sature {Amour {UnPeu 0.0} {Passion 1.0} {Hue 0.5}} {
    set s [expr $UnPeu + ($Passion-$UnPeu)*$Amour]
    set rgb [hsbToRgb $Hue $s 1.]
    set r [lindex $rgb 0]
    set g [lindex $rgb 1]
    set b [lindex $rgb 2]
    set color [format "#%04x%04x%04x" $r $g $b]
    return $color
}

proc Nuance {Amour {UnPeu 0.1} {Passion 0.6}} {
    set h [expr $UnPeu + ($Passion-$UnPeu)*$Amour]
    set rgb [hsbToRgb $h 1. 1.]
    set r [lindex $rgb 0]
    set g [lindex $rgb 1]
    set b [lindex $rgb 2]
    set color [format "#%04x%04x%04x" $r $g $b]
    return $color
}

proc SauveLesLignes {LesLignes dans Fichier} {
    set f [open $Fichier w]
    foreach Ligne $LesLignes {
	puts $f $Ligne
    }
    close $f
    return $Fichier
}

proc Sauve {Texte dans Fichier} {
    set f [open $Fichier w]
    if { $Texte != "" } { puts $f $Texte }
    close $f
    return $Fichier
}

proc FichierPourSaveAs {{RepertoireEtFichier "unnamed"}} {
    global RepertoireInitial

    if {[regexp {/$} $RepertoireEtFichier]} {
	regsub {/$} $RepertoireEtFichier "" Rep
	set Fic ""
    } else {
	set Rep [file dirname $RepertoireEtFichier]
	set Fic [file tail $RepertoireEtFichier]
    }
    if {$Rep!=""} {
	set RepertoireInitial $Rep
    }
    if {$Fic!=""} {
	set FichierInitial "$Fic"
    }

    if { ! [info exists RepertoireInitial]} { set RepertoireInitial [pwd] } 
    if { ! [info exists FichierInitial]}    { set FichierInitial "unnamed"} 

    set Fichier  [tk_getSaveFile -title "File to create" \
	    -initialfile $FichierInitial \
	    -initialdir $RepertoireInitial]
    if { $Fichier == "" } { return ""}
    set RepertoireInitial [file dirname $Fichier]
    return $Fichier
}

proc SaveAs {Page {RepertoireEtFichier "unnamed"}} {
    set Fichier [FichierPourSaveAs $RepertoireEtFichier]
    if {$Fichier==""} { return "" }
    return [Sauve $Page dans $Fichier]
}

proc oldhsbToRgb {hue sat value} {
# The procedure converts an HSB value to RGB.  It takes hue, saturation,
# and value components (floating-point, 0-1.0) as arguments, and returns a
# list containing RGB components (integers, 0-65535) as result.  The code
# here is a copy of the code on page 616 of "Fundamentals of Interactive
# Computer Graphics" by Foley and Van Dam.
    set v [format %.0f [expr 65535.0*$value]]
    if {$sat == 0} {
        return "$v $v $v"
    } else {
        set hue [expr $hue*6.0]
        if {$hue >= 6.0} {
            set hue 0.0
        }
        scan $hue. %d i
        set f [expr $hue-$i]
        set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
        set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
        set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
        case $i \
            0 {return "$v $t $p"} \
            1 {return "$q $v $p"} \
            2 {return "$p $v $t"} \
            3 {return "$p $q $v"} \
            4 {return "$t $p $v"} \
            5 {return "$v $p $q"}
        error "i value $i is out of range"
    }
}

proc PaletteDeCouleurs {{CouleurParDefaut "black"}} {
    global red green blue colorSpace color updating autoUpdate
    global LaCouleurDePaletteDeCouleurs
    global PEnGlobalPourPaletteDeCouleurs
    global CouleurNommeePourPaletteDeCouleurs

    set P [NomDe palette]
    toplevel $P
    wm title $P "This widget is taken from the TK8.2's demos. Adapted for GScope by Raymond Ripp."
    set PEnGlobalPourPaletteDeCouleurs $P
# Global variables that control the program:
#
# colorSpace -			Color space currently being used for
#				editing.  Must be "rgb", "cmy", or "hsb".
# label1, label2, label3 -	Labels for the scales.
# red, green, blue -		Current color intensities in decimal
#				on a scale of 0-65535.
# color -			A string giving the current color value
#				in the proper form for x:
#				#RRRRGGGGBBBB
# updating -			Non-zero means that we're in the middle of
#				updating the scales to load a new color,so
#				information shouldn't be propagating back
#				from the scales to other elements of the
#				program:  this would make an infinite loop.
# command -			Holds the command that has been typed
#				into the "Command" entry.
# autoUpdate -			1 means execute the update command
#				automatically whenever the color changes.
# name -			Name for new color, typed into entry.

    set colorSpace hsb
    set red 65535
    set green 0
    set blue 0
    if {$CouleurParDefaut == "black"} {
	set CouleurParDefaut #000000000000
    } else {
	set list [winfo rgb $P $CouleurParDefaut]
	set red [lindex $list 0]
	set green [lindex $list 1]
	set blue [lindex $list 2]
	set CouleurParDefaut [format "#%04x%04x%04x" $red $green $blue]
    }
    set color $CouleurParDefaut
    set updating 0
    set autoUpdate 0
    set CouleurNommeePourPaletteDeCouleurs ""
    
# Create the menu bar at the top of the window.

    frame $P.menu -relief raised -borderwidth 2
    pack $P.menu -side top -fill x
    menubutton $P.menu.file -text "ColorSpace : RGB, CMY or HSB" -menu $P.menu.file.m -underline 0
    menu $P.menu.file.m
         $P.menu.file.m add radio -label "RGB color space" -variable colorSpace \
		 -value rgb -underline 0 -command "changeColorSpace rgb $P"
         $P.menu.file.m add radio -label "CMY color space" -variable colorSpace \
		 -value cmy -underline 0 -command "changeColorSpace cmy $P"
         $P.menu.file.m add radio -label "HSB color space" -variable colorSpace \
		 -value hsb -underline 0 -command "changeColorSpace hsb $P"
#         $P.menu.file.m add separator
#         $P.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
#		 -value 1 -underline 0
#         $P.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
#		 -value 0 -underline 0
#         $P.menu.file.m add separator
#         $P.menu.file.m add command -label "Exit program" -underline 0 \
#		 -command { set LaCouleurDePaletteDeCouleurs "" }
    pack $P.menu.file -side left

# Create the command entry window at the bottom of the window, along
# with the update button.

    frame $P.bot -relief raised -borderwidth 2
     pack $P.bot -side bottom -fill x
    label $P.commandLabel -text "Command:"
    entry $P.command -relief sunken -borderwidth 2 -textvariable command \
	    -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
    button $P.update  -text "Accept"  -background "green" -command {set LaCouleurDePaletteDeCouleurs $color}
    button $P.dismiss -text "Dismiss" -background "red"   -command {set LaCouleurDePaletteDeCouleurs ""}
#      pack $P.commandLabel -in $P.bot -side left
      pack $P.dismiss -in $P.bot -side right -pady .1c -padx .25c
      pack $P.update -in $P.bot -side right -pady .1c -padx .25c
#      pack $P.command -in $P.bot -expand yes -fill x -ipadx 0.25c
    
# Create the listbox that holds all of the color names in rgb.txt,
# if an rgb.txt file can be found.

    frame $P.middle -relief raised -borderwidth 2
     pack $P.middle -side top -fill both
    foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt \
	    /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt \
	    /usr/openwin/lib/X11/rgb.txt} {
	if ![file readable $i] { continue }
	set f [open $i]
	frame $P.middle.left
	 pack $P.middle.left -side left -padx .25c -pady .25c
	listbox $P.names -width 20 -height 12 -yscrollcommand "$P.scroll set" \
		-relief sunken -borderwidth 2 -exportselection false
	bind $P.names <Double-1> "tc_loadNamedColor \[$P.names get \[$P.names curselection\]\] $P"
	scrollbar $P.scroll -orient vertical -command "$P.names yview" \
		-relief sunken -borderwidth 2
	pack $P.names -in $P.middle.left -side left
	pack $P.scroll -in $P.middle.left -side right -fill y
	while {[gets $f line] >= 0} {
	    if {[llength $line] == 4} {
		$P.names insert end [lindex $line 3]
	    }
	}
	close $f
	break
    }

# Create the three scales for editing the color, and the entry for
# typing in a color value.

    frame $P.middle.middle
     pack $P.middle.middle -side left -expand yes -fill y
    frame $P.middle.middle.1
    frame $P.middle.middle.2
    frame $P.middle.middle.3
    frame $P.middle.middle.4
     pack $P.middle.middle.1 $P.middle.middle.2 $P.middle.middle.3 -side top -expand yes
     pack $P.middle.middle.4 -side top -expand yes -fill x
    foreach i {1 2 3} {
	label $P.label$i -textvariable label$i
	scale $P.scale$i -from 0 -to 1000 -length 6c -orient horizontal \
		-command "tc_scaleChanged $P"
	 pack $P.scale$i $P.label$i -in $P.middle.middle.$i -side top -anchor w
    }
    label $P.nameLabel -text "Name:"
    entry $P.name -relief sunken -borderwidth 2 -textvariable CouleurNommeePourPaletteDeCouleurs -width 10 \
	    -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
     pack $P.nameLabel -in $P.middle.middle.4 -side left
     pack $P.name -in $P.middle.middle.4 -side right -expand 1 -fill x
     bind $P.name <Return> {tc_loadNamedColor $CouleurNommeePourPaletteDeCouleurs $PEnGlobalPourPaletteDeCouleurs}
    
# Create the color display swatch on the right side of the window.
    
    frame $P.middle.right
     pack $P.middle.right -side left -pady .25c -padx .25c -anchor s
    frame $P.swatch -width 2c -height 5c -background $color
    label $P.value -textvariable color -width 13 \
	    -font -Adobe-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
     pack $P.swatch -in $P.middle.right -side top -expand yes -fill both
     pack $P.value -in $P.middle.right -side bottom -pady .25c

    changeColorSpace hsb $P
    tkwait variable LaCouleurDePaletteDeCouleurs
    destroy $P
    return $LaCouleurDePaletteDeCouleurs
}


# The procedure below is invoked when one of the scales is adjusted.
# It propagates color information from the current scale readings
# to everywhere else that it is used.

proc tc_scaleChanged {P args} {
    global red green blue colorSpace color updating autoUpdate
    global LaCouleurDePaletteDeCouleurs
    if $updating {
	return
    }
    if {$colorSpace == "rgb"} {
	set red   [format %.0f [expr [$P.scale1 get]*65.535]]
	set green [format %.0f [expr [$P.scale2 get]*65.535]]
	set blue  [format %.0f [expr [$P.scale3 get]*65.535]]
    } else {
	if {$colorSpace == "cmy"} {
	    set red   [format %.0f [expr {65535 - [$P.scale1 get]*65.535}]]
	    set green [format %.0f [expr {65535 - [$P.scale2 get]*65.535}]]
	    set blue  [format %.0f [expr {65535 - [$P.scale3 get]*65.535}]]
	} else {
	    set list [hsbToRgb [expr {[$P.scale1 get]/1000.0}] \
		    [expr {[$P.scale2 get]/1000.0}] \
		    [expr {[$P.scale3 get]/1000.0}]]
	    set red [lindex $list 0]
	    set green [lindex $list 1]
	    set blue [lindex $list 2]
	}
    }
    set color [format "#%04x%04x%04x" $red $green $blue]
    $P.swatch config -bg $color
    if { $autoUpdate } {
	set LaCouleurDePaletteDeCouleurs $color
    }
    update idletasks
}

# The procedure below is invoked to update the scales from the
# current red, green, and blue intensities.  It's invoked after
# a change in the color space and after a named color value has
# been loaded.

proc tc_setScales P {
    global red green blue colorSpace updating
    set updating 1
    if {$colorSpace == "rgb"} {
	$P.scale1 set [format %.0f [expr $red/65.535]]
	$P.scale2 set [format %.0f [expr $green/65.535]]
	$P.scale3 set [format %.0f [expr $blue/65.535]]
    } else {
	if {$colorSpace == "cmy"} {
	    $P.scale1 set [format %.0f [expr (65535-$red)/65.535]]
	    $P.scale2 set [format %.0f [expr (65535-$green)/65.535]]
	    $P.scale3 set [format %.0f [expr (65535-$blue)/65.535]]
	} else {
	    set list [rgbToHsv $red $green $blue]
	    $P.scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
	    $P.scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
	    $P.scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
	}
    }
    set updating 0
}

# The procedure below is invoked when a named color has been
# selected from the listbox or typed into the entry.  It loads
# the color into the editor.

proc tc_loadNamedColor {name P} {
    global red green blue color autoUpdate
    global LaCouleurDePaletteDeCouleurs

    if {[string index $name 0] != "#"} {
	set list [winfo rgb $P.swatch $name]
	set red   [lindex $list 0]
	set green [lindex $list 1]
	set blue  [lindex $list 2]
    } else {
	case [string length $name] {
	     4 {set format "#%1x%1x%1x"; set shift 12}
	     7 {set format "#%2x%2x%2x"; set shift 8}
	    10 {set format "#%3x%3x%3x"; set shift 4}
	    13 {set format "#%4x%4x%4x"; set shift 0}
	    default {error "syntax error in color name \"$name\""}
	}
	if {[scan $name $format red green blue] != 3} {
	    error "syntax error in color name \"$name\""
	}
	set red   [expr $red<<$shift]
	set green [expr $green<<$shift]
	set blue  [expr $blue<<$shift]
    }
    tc_setScales $P
    set color [format "#%04x%04x%04x" $red $green $blue]
    $P.swatch config -bg $color
    if { $autoUpdate }  {
	set LaCouleurDePaletteDeCouleurs $color
    }
}

# The procedure below is invoked when a new color space is selected.
# It changes the labels on the scales and re-loads the scales with
# the appropriate values for the current color in the new color space

proc changeColorSpace {space P} {
    global label1 label2 label3
    if {$space == "rgb"} {
	set label1 Red
	set label2 Green
	set label3 Blue
	tc_setScales $P
	return
    }
    if {$space == "cmy"} {
	set label1 Cyan
	set label2 Magenta
	set label3 Yellow
	tc_setScales $P
	return
    }
    if {$space == "hsb"} {
	set label1 Hue
	set label2 Saturation
	set label3 Brightness
	tc_setScales $P
	return
    }
}

# The procedure below converts an RGB value to HSB.  It takes red, green,
# and blue components (0-65535) as arguments, and returns a list containing
# HSB components (floating-point, 0-1) as result.  The code here is a copy
# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
# by Foley and Van Dam.

proc rgbToHsv {red green blue} {
    if {$red > $green} {
	set max $red.0
	set min $green.0
    } else {
	set max $green.0
	set min $red.0
    }
    if {$blue > $max} {
	set max $blue.0
    } else {
	if {$blue < $min} {
	    set min $blue.0
	}
    }
    set range [expr $max-$min]
    if {$max == 0} {
	set sat 0
    } else {
	set sat [expr {($max-$min)/$max}]
    }
    if {$sat == 0} {
	set hue 0
    } else {
	set rc [expr {($max - $red)/$range}]
	set gc [expr {($max - $green)/$range}]
	set bc [expr {($max - $blue)/$range}]
	if {$red == $max} {
	    set hue [expr {.166667*($bc - $gc)}]
	} else {
	    if {$green == $max} {
		set hue [expr {.166667*(2 + $rc - $bc)}]
	    } else {
		set hue [expr {.166667*(4 + $gc - $rc)}]
	    }
	}
	if {$hue < 0.0} {
	    set hue [expr $hue + 1.0]
	}
    }
    return [list $hue $sat [expr {$max/65535}]]
}

# The procedure below converts an HSB value to RGB.  It takes hue, saturation,
# and value components (floating-point, 0-1.0) as arguments, and returns a
# list containing RGB components (integers, 0-65535) as result.  The code
# here is a copy of the code on page 616 of "Fundamentals of Interactive
# Computer Graphics" by Foley and Van Dam.

proc hsbToRgb {hue sat value} {
    set v [format %.0f [expr 65535.0*$value]]
    if {$sat == 0} {
	return "$v $v $v"
    } else {
	set hue [expr $hue*6.0]
	if {$hue >= 6.0} {
	    set hue 0.0
	}
	scan $hue. %d i
	set f [expr $hue-$i]
	set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
	set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
	set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
	case $i \
	    0 {return "$v $t $p"} \
	    1 {return "$q $v $p"} \
	    2 {return "$p $v $t"} \
	    3 {return "$p $q $v"} \
	    4 {return "$t $p $v"} \
	    5 {return "$v $p $q"}
	error "i value $i is out of range"
    }
}

proc TuMontrerasCeQueFaitLeBouton Bouton {
    global QuelBouton
    return [set QuelBouton [after 1000 MontreCeQueFaitLeBouton $Bouton]]
}

proc MontreCeQueFaitLeBouton Bouton {
    global LeBoutonQuiEstMontre

    catch {destroy $LeBoutonQuiEstMontre}

    set LesActions [QueFaitLeBouton $Bouton]
    if {$LesActions == {} } { return "" }
    global RapetisseLesBoutonsDe
    if {[info exists RapetisseLesBoutonsDe($Bouton)]} {
	set TexteActions "[set RapetisseLesBoutonsDe($Bouton)]\n\n[join $LesActions "\n"]"
    } else {
	set TexteActions [join $LesActions "\n"]
    }

    regsub -nocase {\.[a-z_0-9]*$} $Bouton "" FdB
    if {$FdB==""} { return "" }
    regsub -nocase {\.[a-z_0-9]*$} $FdB "" FdFdB
    if {$FdFdB==""} { return "" }

    set x [winfo x $FdB]
    set y [winfo y $FdB]
    incr x [winfo x $Bouton]
    incr y [winfo y $Bouton]
    incr y -10
    set M ${FdFdB}[NomDe message]
    message $M -borderwidth 3 -relief raise -width 800 -text $TexteActions -background "lightyellow" -foreground "black"
    if {[expr $x > 400]} {
	set Anchor se
    } else {
	set Anchor sw
    }
    place $M -x $x -y $y -anchor $Anchor -in $FdFdB
    set LeBoutonQuiEstMontre $M
    return $LeBoutonQuiEstMontre
}

proc LacheLeBouton w {
    global QuelBouton
    global LeBoutonQuiEstMontre
    catch {after cancel $QuelBouton}
    catch {destroy $LeBoutonQuiEstMontre}
}

proc QueFaitLeBouton Bouton {
    set LesActions {}
    foreach Sequence {<1> <2> <3> <Shift-1> <Shift-2> <Shift-3> <Control-1> <Control-2> <Control-3>} {
	set Action {}
	catch {set Action [bind $Bouton $Sequence]}
	if {$Action == {} } { continue }
	lappend LesActions "$Sequence $Action"
    }
    return $LesActions
}

proc QueFontLesBoutonsDe w {
    set LesActions [list " "]
    foreach Bouton [LesBoutonsDeLaFrame $w.buttons] {
	foreach SeqAct [QueFaitLeBouton $Bouton] {
	    lappend LesActions "$Bouton $SeqAct"
	}
    }
    Espionne [join $LesActions "\n"]
#    ShowText [join $LesActions "\n"] "AvecCallProc"
}

proc ExecuteUnBoutonDe w {
    set Tabulation [string repeat " " [string length "Button"]]
    set Sel ""
    catch {set Sel [selection get]}
    foreach Bouton [LesBoutonsDeLaFrame $w.buttons] {
	set Texte [lindex [$Bouton configure -text] 4]
	regsub -all "\n" $Texte " ++ " Texte
	lappend LesActions "Button $Bouton $Texte"
	foreach SeqAct [QueFaitLeBouton $Bouton] {
	    regsub -nocase {<[a-z0-9\-]*> } $SeqAct "" Act
	    regsub {\[selection get\]} $Act "\{$Sel\}" Act
	    lappend LesActions "$Tabulation $Act"
	}
    }
    set Action [ChoixParmi $LesActions]
    if {$Action=="" || [regexp "^Button" $Action]} { return "" }
    return [eval $Action]
}

proc OldRapetisseLesBoutonsDe {w {FonteVoulue ""}} {
    if {$FonteVoulue!=""} { set Fonte $FonteVoulue }
    foreach Bouton [LesBoutonsDeLaFrame $w.buttons] {
	if { ! [info exists Fonte]} {
	    set OldFonte [lindex [$Bouton configure -font] 4]
	    ScanLaListe $OldFonte Police Size Style
	    set NewSize [expr $Size + 1]
	    if {$NewSize==-5} { set NewSize -14 }
	    set Fonte [list "tiny" $NewSize "normal"]
	    Espionne $Fonte
	}
	$Bouton configure -font $Fonte
    }
    return $Fonte
}

proc RapetisseLesBoutonsDe {w {Reset ""}} {
    global RapetisseLesBoutonsDe
    if {$Reset=="Reset" &&  ! [info exists RapetisseLesBoutonsDe($w)]} { return "" }
    set RapetisseLesBoutonsDe($w) 1
    foreach Bouton [LesBoutonsDeLaFrame $w.buttons] {
	set  NewWidth [lindex [$Bouton configure -width] 4]
	incr NewWidth -3
	if {$NewWidth < 3} { set NewWidth 20 } 
	$Bouton configure -width $NewWidth
	continue
	if { ! [info exists RapetisseLesBoutonsDe($w,$Bouton)]} {
	    set Texte [lindex [$Bouton configure -text] 4]
	    set RapetisseLesBoutonsDe($w,$Bouton) $Texte
	    set RapetisseLesBoutonsDe($Bouton)    $Texte
	    regsub -all {[a-z]} $Texte "" NewTexte
	} else {
	    set NewTexte [set RapetisseLesBoutonsDe($w,$Bouton)]
	    unset RapetisseLesBoutonsDe($w,$Bouton)
	    if {[info exists RapetisseLesBoutonsDe($w)]} { unset RapetisseLesBoutonsDe($w) }
	}
	$Bouton configure -text $NewTexte
    }
    return $w
}

proc DetruitUnBoutonDe w {
    set LesBoutons {}
    set Bouton [ChoixParmi [LesBoutonsDeLaFrame $w.buttons]]
    if {$Bouton==""} { return "" }
    if { ! [OuiOuNon "Do You want to remove the button $Bouton ?"]} { return "" }
    destroy $Bouton
    return $Bouton
}

proc ShowText {Page Maniere {NomDuFichierOrigine ""}} {
    Wup "Shows the text Page in a listbox, with a lot of buttons."
    Wup "Copyright 1999 Raymond Ripp"
    global PagePropre

    set w [NomDe fenetre]
    regsub -all {\t} $Page "        " PagePropre($w)
    
    if { $NomDuFichierOrigine == "" } {
	set NomDuFichierOrigine "Tsointsoin"
    }

    toplevel $w
    set Titre "$NomDuFichierOrigine"
    wm title $w "$Titre"
    wm iconname $w "$Titre"

    label $w.msg -wraplength 4i -justify left -text "$Titre"
    pack  $w.msg -side top

    frame  $w.buttons
    pack   $w.buttons -side bottom -fill x -pady 2m

    button $w.buttons.dismiss -text "Dismiss//?" -background "red" -command "destroy $w"
      bind $w.buttons.dismiss <3> "QueFontLesBoutonsDe $w"
      pack $w.buttons.dismiss -side left -expand 1

    button $w.buttons.save -text "Save\nAll/Sel/Edit"
      bind $w.buttons.save <1> "SaveAs \[set PagePropre($w)\]"
      bind $w.buttons.save <2> "SaveAs \[selection get\]"
      bind $w.buttons.save <3> "EditAndShow \[set PagePropre($w)\]"
      bind $w.buttons.save <Control-3> "destroy  $w.buttons.save"
      pack $w.buttons.save -side left -expand 1

    button $w.buttons.focalise -text "Nex/Top/New"
      bind $w.buttons.focalise <1> "Focalise $w" 
      bind $w.buttons.focalise <2> "Focalise $w top" 
      bind $w.buttons.focalise <3> "Focalise $w ask" 
      pack $w.buttons.focalise -side left -expand 1

    if { [regexp "AvecShow" $Maniere] } {
	button $w.buttons.show  -text "Show" -background green -foreground black
	  bind $w.buttons.show <1> {AfficheLesFichiers "[selection get]" "GrandeLargeur"}
	  pack $w.buttons.show  -side right -expand 1
    }

    if {[regexp "AvecAffiProc" $Maniere]} {
 	button $w.buttons.affiproc -text "Show" -background "green"
          bind $w.buttons.affiproc <1> "AfficheLaProc \[selection get\]" 
	  pack $w.buttons.affiproc -side left -expand 1
    }
    if {[regexp "AvecCallProc" $Maniere]} {
	button $w.buttons.quijappel -text "Called Procs sel./all" -background "green" 
	  bind $w.buttons.quijappel <1> "QuiJAppel $NomDuFichierOrigine \[selection get\] "
	  bind $w.buttons.quijappel <2> "AfficheLesProcs NameIsIn \[QuiJAppel $NomDuFichierOrigine LaListeMerci\]"
	  pack $w.buttons.quijappel -side left -expand 1
	button $w.buttons.quimappel -text "Calling Procs" -background "yellow"
	  bind $w.buttons.quimappel <1> "QuiMAppel $NomDuFichierOrigine"
	  pack $w.buttons.quimappel -side left -expand 1
 	button $w.buttons.execute -text "Execute\nEdit\nNew proc" -background "orange"
	  bind $w.buttons.execute <1>       "CompleteEtExecute \[selection get\]" 
	  bind $w.buttons.execute <Shift-1>  "CreeUneNouvelleProcedure \[set PagePropre($w)\]" 
	  bind $w.buttons.execute <Control-1> "CreeUneNouvelleProcedure"
	  pack $w.buttons.execute -side left -expand 1
    }

    frame $w.frame -borderwidth 5
    pack  $w.frame -side top -expand yes -fill both
    
    
    scrollbar $w.frame.yscroll -command "$w.frame.list yview"
    scrollbar $w.frame.xscroll -command "$w.frame.list xview" \
	                       -orient horizontal 
    set Largeur 80
    set Hauteur 30
    if { [regexp "GrandeLargeur" $Maniere] } { set Largeur 128 }
    listbox $w.frame.list -width $Largeur -height $Hauteur -setgrid 1 \
	    -yscroll "$w.frame.yscroll set" \
	    -xscroll "$w.frame.xscroll set" \
	    -selectmode extended \
	    -background "deepskyblue4" \
	    -foreground "white" \
	    -font {Courier 10}
    
    grid $w.frame.list    -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky nsew
    grid $w.frame.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky nsew
    grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky nsew
    grid rowconfig    $w.frame 0 -weight 1 -minsize 0
    grid columnconfig $w.frame 0 -weight 1 -minsize 0
    
    foreach Ligne [split [set PagePropre($w)] "\n"] {
	$w.frame.list insert end $Ligne
    }

    return $w
}

proc AfficheLaRechercheDansLesBody {{Texte ""}} {
    set LesTrouvees [RechercheDansLesBody $Texte]
    if {$LesTrouvees=={}} { return "" }
    return [ShowText [join $LesTrouvees "\n"] \
	    "SansFetchAvecRienAvecAffiProc" "Procs containing your text."]
}

proc RechercheDansLesBody {{Texte ""}} {
    Wup "Asks which text is to search in all proc bodies"
    if {$Texte==""} {
	set Texte [Entre ""]
	if {$Texte==""} { return ""}
    }
    set LesTrouvees {}
    foreach Proc [LesProceduresExistantes] {
	set Body [info body $Proc]
	if {[regexp -nocase $Texte $Body]} {
	    lappend LesTrouvees $Proc
	}
    }
    return $LesTrouvees
}

proc LesProceduresExistantes {} {
    Wup "Returns the list of existing procs ... begining with Uppercase" 
    global LesProceduresExistantes

    if { ! [info exists LesProceduresExistantes]} {
	set LesProceduresExistantes [lsort [info procs]]
	set iMinuscule [lsearch -regexp $LesProceduresExistantes {^[a-z]}]
	if {$iMinuscule > -1} {
	    set LesProceduresExistantes [lrange $LesProceduresExistantes 0 [incr iMinuscule -1]]
	}
    }

    return $LesProceduresExistantes
}

proc AfficheLaProc Procedure {

    Wup "Shows the proc Procedure or lappend to the called procs"

    scan [string trim $Procedure] "%s" Procedure

    if {[info procs $Procedure]=={}} { return "" }
 
    set Args [info args $Procedure]
    set Body [info body $Procedure]
    set LaProc "$Procedure \{$Args\} \{"
    append LaProc "\n$Body\n\}"
    
    return [ShowText $LaProc "SansFetchAvecRienAvecCallProcGrandeLargeur" "$Procedure"]
}

proc AppendLaProc {SousProcedure Procedure} {
    global LesSousProcedures

    if {[info procs $SousProcedure]=={}} { return }

    lappend LesSousProcedures($Procedure) $SousProcedure
}

proc AfficheLesProcs {{LesQuelles ""} {Liste {}}} {
    Wup "Shows the names and args of all Procs"
    
    Gs "Frame"
    
    if { ! [AutorisationPourPsy] } { return "" }

    set LesBonnes {}
    foreach Procedure [LesProceduresExistantes] {
	set Args [info args $Procedure]
	set UneBonne "$Procedure \{$Args\}"
	if {[regexp "^ArgsContain" $LesQuelles]} {
	    regsub "^ArgsContain\:" $LesQuelles "" ArgsVoulus
	    if {$ArgsVoulus!="" && ! [regexp $ArgsVoulus $Args]} { continue }
	}
	if {[regexp "^NameIsIn" $LesQuelles]} {
	    if {[lsearch -exact $Liste $Procedure]==-1} { continue }
	}
	lappend LesBonnes $UneBonne
    }

    if {$LesBonnes=={}} {
	return ""
    }

    set Fenetre [ShowText [join $LesBonnes "\n"] \
	    "SansFetchAvecRienAvecAffiProc" "LesProcs"]
    set Bouton [BoutonneLaFenetre $Fenetre "New" CreeUneNouvelleProcedure]
       $Bouton configure -background "orange"
    set Bouton [BoutonneLaFenetre $Fenetre "Search" AfficheLaRechercheDansLesBody]
       $Bouton configure -background "yellow"
    return $Fenetre
}

proc QuiJAppel {Procedure {Selection ""}} {
    global LesSousProcedures

    Wup "Shows the procs that Procedure calls in the Selected lines"

    if {$Selection=="LaListeMerci"} {
	set Selection ""
	set CreerLesSousProcedures 1
	if {[info exists LesSousProcedures($Procedure)]} {
	    return [set LesSousProcedures($Procedure)]
	}
    } else {
	set CreerLesSousProcedures 0
    }

    if {$Selection != ""} {
	set MonBody $Selection
    } else {
	set MonBody [info body $Procedure]
    }

    set Body $MonBody
    while 0 {
	if { ! [regexp -indices {\[[A-Z]} $Body Indices]} { break }
	scan $Indices "%d %d" iCrochet iProc
	set Body [string range $Body $iProc end]
	if {[scan $Body "%s" ProcAppelee]!=1} { continue }
	regsub -all -nocase {[^a-z_0-9]} $ProcAppelee "" ProcAppelee  
	if {[info exists QuiJAppelDejaVu($ProcAppelee)]} { continue }
	set  QuiJAppelDejaVu($ProcAppelee) 1
	if {$CreerLesSousProcedures} {
	    AppendLaProc $ProcAppelee $Procedure 
	} else {
	    AfficheLaProc $ProcAppelee
	}
    }
    set Body $MonBody
    while 1 {
	set i 0
	if {      [regexp -indices {^[ \t]+[A-Z]}    $Body IndicesN([incr i])] \
		| [regexp -indices {[\n][ \t]+[A-Z]} $Body IndicesN([incr i])] \
		| [regexp -indices { +\{[ \t]*[A-Z]} $Body IndicesN([incr i])] \
		| [regexp -indices {\;[ \t]*[A-Z]}   $Body IndicesN([incr i])] \
		| [regexp -indices {\[[ \t]*[A-Z]}   $Body IndicesN([incr i])] } {
	    set iProc 999999
	    foreach {i Ind} [array get IndicesN] {
		scan $Ind "%d %d" iExpr iProcLu
		if {$iProcLu==-1} { continue }
		set iProc [Mini $iProc $iProcLu]
	    }
	    if {$iProc==999999} { break }
	    set Body [string range $Body $iProc end]
	    if {[scan $Body "%s" ProcAppelee]!=1} { continue }
	    regsub -all -nocase {[^a-z_0-9]} $ProcAppelee "" ProcAppelee  
	    if {[info exists QuiJAppelDejaVu($ProcAppelee)]} { continue }
	    set  QuiJAppelDejaVu($ProcAppelee) 1
	    if {$CreerLesSousProcedures} {
		AppendLaProc $ProcAppelee $Procedure 
	    } else {
		AfficheLaProc $ProcAppelee
	    }
	} else {
	    break
	}
    }
    set Body $MonBody
    while 1 {
	if { ! [regexp -indices {command +[\"][A-Z]} $Body Indices]} { break }
	scan $Indices "%d %d" iCommand iProc
	set Body [string range $Body $iProc end]
	if {[scan $Body "%s" ProcAppelee]!=1} { continue }
	regsub -all -nocase {[^a-z_0-9]} $ProcAppelee "" ProcAppelee  
	if {[info exists QuiJAppelDejaVu($ProcAppelee)]} { continue }
	set  QuiJAppelDejaVu($ProcAppelee) 1
	if {$CreerLesSousProcedures} {
	    AppendLaProc $ProcAppelee $Procedure 
	} else {
	    AfficheLaProc $ProcAppelee
	}
    }
    set Body $MonBody
    while 1 {
	if { ! [regexp -indices {> +[\"]*[A-Z]} $Body Indices]} { break }
	scan $Indices "%d %d" iCommand iProc
	set Body [string range $Body $iProc end]
	if {[scan $Body "%s" ProcAppelee]!=1} { continue }
	regsub -all -nocase {[^a-z_0-9]} $ProcAppelee "" ProcAppelee  
	if {[info exists QuiJAppelDejaVu($ProcAppelee)]} { continue }
	set  QuiJAppelDejaVu($ProcAppelee) 1
	if {$CreerLesSousProcedures} {
	    AppendLaProc $ProcAppelee $Procedure 
	} else {
	    AfficheLaProc $ProcAppelee
	}
    }
    if {$CreerLesSousProcedures} {
	if {[info exists LesSousProcedures($Procedure)]} {
	    return [set LesSousProcedures($Procedure)]
	} else {
	    return {}
	}
    }
}

proc QuiMAppel {Procedure {LaListeMerci ""}} {
    Wup "Shows the procs calling Procedure"

    set LesAppelantes {}
    foreach Autre [LesProceduresExistantes] {
	set LesAppeleesParAutre [QuiJAppel $Autre "LaListeMerci"]
	if {[lsearch -exact $LesAppeleesParAutre $Procedure] != -1} {
 	    lappend LesAppelantes $Autre
	}
	continue
	Wup "Reste est pas bon car on cherche tout le texte et pas que les procedures"
	set Body [info body $Autre]
	if {[regexp "$Procedure" $Body]} {
	    lappend LesAppelantes $Autre
	}
    }

    if {$LaListeMerci != ""} { return $LesAppelantes }

    if {$LesAppelantes=={}} {
	FaireLire "No calling procs for $Procedure"
	return ""
    }
    return [ShowText [join $LesAppelantes "\n"] \
	    "SansFetchAvecRienAvecAffiProc" "$Procedure 's CallingProcs "]
}

