no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 4)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
#!/usr/local/bin/wish
##!/home/moumou/TclTk-8.5/bin/wish8.5

package require Tk
package require Tktable

set LignesCoul ">seqlab
I white magenta
L white magenta
M white magenta
V white magenta
ILMV white magenta
R white blue
K white blue
RK white blue
F white red
Y white red
W white red
FYW white red
D white forestgreen
E white forestgreen
DE white forestgreen
Q white green
P white black
G black orange
H black cyan
N black cyan
HN white cyan
S white darkviolet
T white darkviolet
A white darkviolet
C white darkviolet
STAC white darkviolet
SPC white darkslategrey
. white darkslategrey
"

#########
# Tools
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"]
}

#################
# Data generation
# 
proc LitLeTFA {file aNom aSeq} {
    upvar $aNom Nom
    upvar $aSeq Seq
    global Long Haut

    set Lignes [LesLignesDuFichier $file]
    lappend Lignes ">"
    set n 0
    set laseq ""
    foreach l $Lignes {
	set l [string trim $l]
	if {$l eq ""} {continue}
	if {[string index $l 0] eq ">"} {
	    if {$laseq ne ""} {
		regsub -all " "  $laseq ""  laseq
		regsub -all {\-} $laseq "." laseq
		regsub -all {\n} $laseq ""  laseq
		lappend Nom $lenom
		set Seq($lenom) $laseq
		set laseq ""
		incr n
	    }

	    set l [string trim [string range $l 1 end]]
	    set ib [string first " " $l]
	    if {$ib == -1} {
		set ib end
	    } else {
		incr ib -1
	    }
	    set lenom [file rootname [string range $l 0 $ib]]
	} else {
	    append laseq $l
	}
    }
    set Haut $n
    set Long [string length [set Seq([lindex $Nom 0])]]
    puts "tfa Long $Long Haut $Haut"
    return $n
}

# tfa file
proc TfaData {{f ""}} {
    global data dataN

    LitLeTFA $f Nom Seq
    set data ""
    foreach n $Nom {
	append data "[set Seq($n)]\n"
	append dataN "$n \n"
    }

    return $data
}


###################################
# Configure tags for 20 amino acids
# + physicochemical groups
# almost taken from ordali
proc ConfTag {} {
    global LignesCoul
    global wtx wtn

    foreach c [lrange [split $LignesCoul "\n"] 1 end] {
	foreach {n f b} $c {}
	$wtx tag configure Tag$n -foreground $f -background $b
    }

    $wtn tag configure InvN -foreground white -background black
    $wtn tag configure NrmN -foreground black -background white

    return
}

#################
# Data generation
# 
# Junk data or read a TFA file given as argument
proc JunkData {} {
    global data Long Haut    

    set l "A.C.P.Q.G.I.K.D.N.F."
    set rep [expr {int($Long/20)}]
    set dt [string repeat $l $rep]
    set data "$dt\n"
    for {set i 1} {$i < $Haut} {incr i} {
	set s [string range $dt $i end]
	append s "[string range $dt 0 [expr {$i-1}]]\n"
	append data $s
    }
#    set data "[string repeat $dt $Haut]"
    set Long [string length $dt]

    return $data
}

proc Remp2 {} {
    global data dataN
    global LData LDataN
    
    set LDataN [split $dataN "\n"]
    foreach l [split $data "\n"] {
	lappend LData [split $l ""]
    }

    return
}

proc Remplissage {} {
    global data dataN
    global TData TDataN
    global wtx wtn

    set Ll [split $data "\n"]
    set y 0
    foreach l $Ll {
	set Lc [split $l ""]
	set x 0
	foreach c $Lc {
	    set TData($y,$x) $c
	    if {$c ne "."} {lappend LTag(Tag$c) $y,$x}
	    incr x	    
	}
	incr y
    }

    foreach t [array names LTag] {
	eval $wtx tag cell $t [set LTag($t)]
    }

    set y 0
    foreach n [split $dataN "\n"] {
	set TDataN($y,0) $n
	incr y
    }

    return
}

proc InsereGapATous w {
    global TData 
    global Long Haut

    $w insert cols end
    for {set i 0} {$i<$Haut} {incr i} {set TData($i,$Long) "."}
    return
}

proc BindTextSpace {w c} {
    global TData Long

    InsereGapATous $w
    foreach {yp xp} [split [$w index active] ,] {}

    for {set y 3} {$y<11} {incr y} {
	for {set i $Long} {$i>$xp} {incr i -1} {
	    set im $y,[expr {$i-1}]
	    set Ct [set TData($im)]
	    set TData($y,$i) $Ct
#	    lappend Ldel $im
#	    lappend LTag(Tag$Ct) $y,$i
#	    if {$Ct ne "."} {$w tag cell Tag$Ct $y,$i}
	    $w tag cell {} $im
	    $w tag cell Tag$Ct $y,$i
	}
	set TData($y,$xp) "."
    }
    
#    eval $w tag cell {} $Ldel
#    foreach t [array names LTag] {eval $w tag cell $t $LTag($t)}

    incr Long
    $w configure -cols $Long
    $w activate $yp,[expr {$xp+1}]
    $w selection clear all
    $w selection set active
    $w see active

    update idletasks

    return
}

##############################
# Window and attached commands
#
# trash window test ... no grid , nothing ...
proc CoupleY {w1 w2 args} {
    eval $w1 yview $args
    eval $w2 yview $args

    return
}

proc ToggleMode {} {
    global wtx wtn wxx wxn wsx wsy

    set Ls [grid slaves .f3]
    if {[lsearch $Ls "$wxx"] != -1} {
	Remp2
	grid forget $wxn
	grid forget $wxx
	grid $wtn -row 0 -column 0 -sticky ns
	grid $wtx -row 0 -column 1 -sticky news
	$wtx configure -foreground white -background "#303030303030"
	bind $wtx  {focus %W}
	bind $wtn  {focus %W}
	$wsx configure -command "$wtx xview"
	$wsy configure -command "CoupleY $wtx $wtn"
#	Remplissage
    } else {
	grid forget $wtx
	grid forget $wtn
	grid $wxn -row 0 -column 0 -sticky news
	grid $wxx -row 0 -column 1 -sticky news
	$wsx configure -command "$wxx xview"
	$wsy configure -command "CoupleY $wxx $wxn"
	$wtn tag configure active -foreground ""
	$wtn tag configure sel    -foreground ""
    }

    update idletasks

    return
}

proc SelectLesNoms {w yp xp {mode "set"}} {
    global NomSeqSel

    foreach {y x} [split [$w index @$xp,$yp] ,] {}
    switch $mode {
	"set" {
	    $w clear tags
	    set NomSeqSel $y
	    $w tag cell InvN $y,0
	}
	"extend" {
	    for {set i [expr [lindex $NomSeqSel end]+1]} {$i <= $y} {incr i} {
		lappend NomSeqSel $i
		$w tag cell InvN $i,0
	    }
	}
	"add" {
	}
    }

    $w tag raise InvN
    update idletasks

    return
}

proc CutLesNoms {} {
    global NomSeqSel
    global LData LDataN
    global wtx wtn

    CopyLesNoms

    $wtn configure -state normal
    $wtx configure -state normal
    $wtx configure -usecommand 0
    $wtn configure -usecommand 0

    set Li [lsort -integer -decreasing $NomSeqSel]
    set if [lindex $Li 0]
    set n 1
    foreach i [lrange $Li 1 end] {
	if {$i+1 == $if} {
	    incr n
	    set if $i
	} else {
	    lappend Ldel $if $n
	    set n 1
	    set if $i
	}
    }
    lappend Ldel $if $n

    foreach {i n} $Ldel {
	$wtn delete rows $i $n
	$wtx delete rows $i $n
	set LData  [lreplace $LData  $i [expr {$i+$n-1}]]
	set LDataN [lreplace $LDataN $i [expr {$i+$n-1}]]
   }
   set NomSeqSel {}
   $wtn clear tags

   $wtx configure -usecommand 1
   $wtn configure -usecommand 1
   $wtn configure -state disabled
   $wtx configure -state disabled
   
   update idletasks
   
    return
}

proc CopyLesNoms {} {
    global NomSeqSel
    global BufferSeq
    global wtn wtx
    global TData TDataN
    global LData LDataN

    set Long [$wtx cget -cols]
    foreach i $NomSeqSel {
	set nom [lindex $LDataN $i]
	set seq [lindex $LData  $i]
	lappend BufferSeq [list $nom $seq]
    }
   
   return
}

proc PasteLesNoms {} {
    global NomSeqSel
    global BufferSeq
    global wtn wtx
    global TData TDataN
    global LData LDataN

    $wtn configure -state normal
    $wtx configure -state normal
    $wtx configure -usecommand 0
    $wtn configure -usecommand 0

    set y $NomSeqSel

    $wtx insert row $y [llength $BufferSeq]
    $wtn insert row $y [llength $BufferSeq]
    incr y
    foreach e $BufferSeq {
	foreach {n s} $e {}
	set LData  [linsert $LData  $y $s]
	set LDataN [linsert $LDataN $y $n]
	incr y
    }

    $wtx configure -usecommand 1
    $wtn configure -usecommand 1
    $wtn configure -state disabled
    $wtx configure -state disabled

    update idletasks

#    parray TData
#    parray TDataN

    return
}

proc DonneS {v w r c} {
    global $v

    set Val [lindex [lindex [set $v] $r] $c]
    if {$Val ne "."} {$w tag cell Tag$Val $r,$c}
    return $Val
}
proc DonneN {v r} {
    global $v

    return [lindex [set $v] $r]
}

proc InitWindow {} {
    global data dataN
    global wtx wtn wxx wxn wsx wsy
    global Long Haut

    set wtn .f3.tn
    set wtx .f3.tx
    set wxx .f3.xx
    set wxn .f3.xn
    set wsx .f3.sx
    set wsy .f3.sy

    frame .f3 
    table .f3.tn -font "Courier 10 bold" -anchor w\
	    -yscrollcommand "$wsy set" \
	    -resizeborders none \
	    -drawmode fast -relief flat \
	    -command [list DonneN LDataN %r] -state disabled \
	    -height 30 -width 1 \
	    -bd [list 0 0 0 0] \
	    -cols 1 -colwidth 10 -rows $Haut \
	    -rowstretch unset -colstretch unset
    table .f3.tx -font "Courier 10 bold" \
	    -yscrollcommand "$wsy set" \
	    -xscrollcommand "$wsx set" \
	    -resizeborders none \
	    -drawmode fast -relief flat \
	    -command [list DonneS LData %W %r %c] -state disabled \
	    -height 30 -width 100 -state disabled \
	    -bd [list 0 0 0 0] \
	    -cols $Long -colwidth 1 -rows $Haut \
	    -rowstretch unset -colstretch unset

    text  .f3.xn -font "Courier 10 bold" \
	    -yscrollcommand "$wsy set" \
	    -height 30 -width 10 -wrap none
    text  .f3.xx -font "Courier 10 bold" \
	    -yscrollcommand "$wsy set" \
	    -xscrollcommand "$wsx set" \
	    -height 30 -width 100 -wrap none
    
    scrollbar .f3.sy -command "CoupleY $wxx $wxn"
    scrollbar .f3.sx -command "$wxx xview" -orient horizontal    
    button    .f3.b  -command {ToggleMode} -bg green

    grid columnconfig .f3 1 -weight 1
    grid rowconfig    .f3 0 -weight 1
    grid .f3.xn  -row 0 -column 0 -sticky ns
    grid .f3.xx  -row 0 -column 1 -sticky news
    grid .f3.sy -row 0 -column 2 -sticky ns
    grid .f3.sx -row 1 -column 1 -sticky we
    grid .f3.b  -row 2 -column 1 -sticky we

    pack .f3 -side top -expand 1 -fill both
    update

    $wxx insert end $data
    $wxn insert end $dataN

    bind Table "" ""

#    bind $wtx <4> "$wt yview scroll -2 units"
#    bind $wtx <5> "CoupleY"
    bind $wtx  {BindTextSpace %W %C}

    bind $wtn <1>       {SelectLesNoms %W %y %x}
    bind $wtn  {SelectLesNoms %W %y %x "extend"}
    bind $wtn  {CutLesNoms}
    bind $wtn  {CopyLesNoms}
    bind $wtn  {PasteLesNoms}
    update idletasks

    return
}

proc TagAll {} {
    global wt Lgaa Lfreg data

    set i 0
    foreach s [split $data "\n"] {
	incr i
	foreach freg $Lfreg g $Lgaa {
	    set lv [regexp -all -inline -indices -- $freg $s]
	    set lt {}
	    foreach e $lv {
		foreach {d f} $e {}
		lappend lt $i.$d $i.[expr {$f+1}]
	    }
	    if {$lt != {}} {eval [list $wt tag add Tag$g] $lt}
	}
    }
    update idletasks	
    
    return
}


#################################
if {$argc == 0} {
    set Long 5000
    set Haut 500
    set data [JunkData]
} else {
    set data [TfaData [lindex $argv 0]]
}
InitWindow
puts "Length $Long Height $Haut"
ConfTag 

########### la fin des haricots ##############