Something

#!/usr/bin/wish

####################################################
# Script de réorganisation du fichier channels.conf.
# Créé le 06 novembre 2007
# par l_arsene
# commentaires à envoyer à l_arsene@hotmail.com
####################################################
# TODO: 
# -Reste à implementer une gestion drag & drop
# pour eviter de cliquer 500 fois "up"
# -Ajouter un editeur de ligne pour pouvoir modifier
# une ligne manuellement
####################################################

#package require BWidget

#lecture du fichier channels.conf
global listing
if {$argc == 0} {
	set fichier [tk_getOpenFile]
} else {
	set fichier [lindex $argv 0]
}
set fic [open $fichier r]
while {[eof $fic] == 0} {
	lappend listing [gets $fic]}
close $fic

#Mise en place GUI
wm title . "Trieuse"
wm geometry . 800x600
frame .ls
listbox .ls.lb -listvariable listing -selectmode extended
scrollbar .ls.vs -orient vertical
pack .ls.vs -side left -fill y
pack .ls.lb -side left -expand 1 -fill both
frame .but
button .but.up -text up -command {monter [lindex [.ls.lb curselection] 0]} -background grey
button .but.down -text down -command {descendre [lindex [.ls.lb curselection] 0]} -background grey
button .but.del -text Supprimer -command supprimer -background grey
button .but.edit -text Modifier -command {editeur [lindex [.ls.lb curselection] 0]} -background grey
button .but.save -text OK -command sortir -background grey
button .but.quitter -text Quitter -command quitter -background grey
button .but.sep -text Séparateur: -command {separateur [lindex [.ls.lb curselection] 0]} -background grey
entry .but.septxt -textvariable separateur
pack .but.up .but.down .but.del .but.edit .but.save .but.quitter .but.sep .but.septxt -expand 1 -side left
pack .but -side bottom
pack .ls -side bottom -expand 1 -fill both
.ls.lb configure -yscrollcommand [list .ls.vs set]
.ls.vs configure -command [list .ls.lb yview]
.ls.lb selection set 0

#début des procedures
proc deplace {position sel} {
   global listing

   #Tout d'abord créer une liste temporaire contenant les selectionnés
   switch -regexp [lindex $sel 0] {
      ^\[0-9\]+ {
         foreach indice [.ls.lb curselection] {
            lappend selliste [lindex $listing $indice]
         }
      }
      ^: {
         set selliste $sel
      }
   }
   #ensuite on purge la liste originale des elements selectiones
   foreach selectione $selliste {
      set listing [lsearch -all -inline -not -exact $listing $selectione]
   }
   .ls.lb selection clear 0 end
   if {$position != -1} {
      #ensuite on ajoute la selection à l'endroit désiré
      set listing [concat [lrange $listing 0 [expr $position -1]] $selliste [lrange $listing $position end]]
      #enfin on reselectionne les elements precedement selectionnes
      foreach selectione $selliste {
         .ls.lb selection set [lsearch $listing $selectione]
      }
   }
colorize
.ls.lb yview [expr $position-5>0?$position-5:0]
}

proc monter {val} {
   set sel [.ls.lb curselection]
   deplace [expr $val-1>0?$val-1:0] $sel
}
proc descendre {val} {
   set sel [.ls.lb curselection]
   deplace [expr $val + 1] $sel
}
proc separateur {val} {
   global separateur
   if {$separateur == ""} {
      tk_messageBox -message "Veuillez entrer tout d'abord un label de séparateur!!"
   } else {
      set sel :$separateur
      deplace [expr $val] $sel
      set separateur ""
   }
}
proc supprimer {} {
   set sel [.ls.lb curselection]
   deplace -1 $sel
}
proc sortir {} {
   global listing fichier
   set err [catch "open {$fichier} w" fic]
   while {$err != 0} {
      tk_messageBox -message "Erreur d'ouverture en ecriture du fichier:\n$fic"
      set dir [tk_chooseDirectory]
      set err [catch "open ${dir}/channels.conf w" fic]
   }
   foreach ligne $listing {
      puts $fic $ligne
   }
   close $fic
   exit
}
proc inputBox {} {
   return Separateur
}
proc colorize {} {
   global listing
   for {set i 0} {$i < [llength $listing] -1 } {incr i} {
      set ligne [lindex $listing $i]
      set VPID [lindex [split $ligne :] 5]
      if {$VPID <= 1} {set color red} else {set color black}
      if {[llength [split $ligne :]] <= 2} {set color blue}
      .ls.lb itemconfigure $i -foreground $color
   }
}
proc quitter {} {
   if {[tk_dialog .dg "Sortie" "Etes-vous sûr de vouloir quitter sans sauver?" "" 1 Oui Non] == 0} {exit}
}
proc editeur {val} {
   global listing tmp
   set tmp 0
   set ligne [lindex $listing $val]
   toplevel .dg
   wm geometry .dg 800x20
   entry .dg.dg
   button .dg.ok -text OK -command {incr tmp}
   pack .dg.ok -side right
   pack .dg.dg -side right -fill x -expand 1
   .dg.dg insert 0 $ligne
   vwait tmp
   set listing [lreplace $listing $val $val [.dg.dg get]]
   destroy .dg
   colorize
}

colorize