code-aster-gui 1.8.4-5 / usr / share / astk / ihm_liste.tcl

#########################################################################
# COPYRIGHT (C) 2003         EDF R&D              WWW.CODE-ASTER.ORG    #
#                                                                       #
# THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR         #
# MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS        #
# PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE    #
# LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.                       #
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL,       #
# BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF        #
# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU      #
# GENERAL PUBLIC LICENSE FOR MORE DETAILS.                              #
#                                                                       #
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE     #
# ALONG WITH THIS PROGRAM; IF NOT, WRITE TO : EDF R&D CODE_ASTER,       #
#    1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE.        #
#########################################################################

# $Id: ihm_liste.tcl 3094 2007-10-09 13:33:55Z courtois $

# fournit la liste des colonnes à afficher selon le type de liste
#################################################################
proc colonnes_fich { var } {
   if { $var == "etude" } {
      set lcols {type serv nom ul donnee resultat compress}
   } elseif { $var == "tests" } {
      set lcols {type serv nom    donnee resultat}
   } elseif { $var == "sources" } {
      set lcols {type serv nom    donnee}
   } elseif { $var == "surcharge" } {
      set lcols {type serv nom    donnee resultat}
   }
   return $lcols
}

# liste des fichiers ETUDE, TESTS, SOURCES, SURCHARGE
#################################################################
proc liste_fich {tfic pos_debut var} {
   set nombre $astk::profil($var,nbfic)
   init_sel
   set nblig [lindex [grid size $tfic] 1]
   set lcols [colonnes_fich $var]

   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (liste_fich) var=$var / debut=$pos_debut / nombre=$nombre / nblig=$nblig / tfic=$tfic"
   }

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # entete
   if { $pos_debut == -1 } {
      incr pos_debut
      label $tfic.lig(-1,type)     -font $astk::ihm(font,lab) -text [ashare::mess ihm 14]
      label $tfic.lig(-1,serv)     -font $astk::ihm(font,lab) -text [ashare::mess ihm 15]
      label $tfic.lig(-1,nom)      -font $astk::ihm(font,lab) -text [ashare::mess ihm 16]
      label $tfic.lig(-1,ul)       -font $astk::ihm(font,lab) -text [ashare::mess ihm 17]
      label $tfic.lig(-1,donnee)   -font $astk::ihm(font,lab) -text [ashare::mess ihm 18]
      label $tfic.lig(-1,resultat) -font $astk::ihm(font,lab) -text [ashare::mess ihm 19]
      label $tfic.lig(-1,compress) -font $astk::ihm(font,lab) -text [ashare::mess ihm 20]
      for {set iw 0} {$iw < [llength $lcols]} {incr iw} {
         set wid [lindex $lcols $iw]
         grid $tfic.lig(-1,$wid) -row 0 -column $iw -sticky ew
      }
      # colonnes "étirables"
      grid columnconfigure $tfic 2 -weight 1
   }
   if { $nblig <= 1 && $nombre == 0 } {
      # message d'aide
      label $tfic.mess -font $astk::ihm(font,labpt) -text "[ashare::mess ihm 343]   > > > > >"
      grid $tfic.mess -row 1 -column 0 -columnspan [llength $lcols] -sticky ew -ipady 20
   }
   if { $nombre > 0 } {
      catch {
         grid remove $tfic.mess
         destroy $tfic.mess
      }
   }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # si raffraichissement, faire le ménage
   catch {
      for {set i $pos_debut} {$i < $nombre} {incr i 1} {
         for {set iw 0} {$iw < [llength $lcols]} {incr iw} {
            set wid [lindex $lcols $iw]
            grid remove $tfic.lig($i,$wid)
            destroy $tfic.lig($i,$wid)
         }
      }
   }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # liste des fichiers
   for {set i $pos_debut} {$i < $nombre} {incr i 1} {
   # type
      # interaction avec l'agla
      set ideb 0
      if { $var == "surcharge" && $astk::profil(agla) == "oui" } {
         set ideb 3
      }
      set m [tk_optionMenu $tfic.lig($i,type) astk::profil($var,fich,$i,type) $astk::UL($var,$ideb,nom)]
      $m configure \
        -foreground $astk::ihm(couleur,menu_foreground) \
        -background $astk::ihm(couleur,menu_background)
      $m entryconfigure 0 -font $astk::ihm(font,lablst) -command "set astk::profil($var,fich,$i,UL) $astk::UL($var,$ideb,num)"
      incr ideb
      set ind 0
      for {set j $ideb} {$j < $astk::UL($var,nbre)} {incr j} {
         incr ind
         $m add radiobutton
         $m entryconfigure $ind -label $astk::UL($var,$j,nom) -font $astk::ihm(font,lablst) -command "set_UL $i $j $var ; modprof" -variable astk::profil($var,fich,$i,type)
      }
      $tfic.lig($i,type) configure -font $astk::ihm(font,lablst) -pady 0
      [lindex [$tfic.lig($i,type) configure -menu] 4] configure -type
      $tfic.lig($i,type).menu configure
      def_context $tfic.lig($i,type) 304
   # serv
      set m2 [tk_optionMenu $tfic.lig($i,serv) astk::profil($var,fich,$i,serv) $astk::config(-1,nom)]
      $m2 configure \
        -foreground $astk::ihm(couleur,menu_foreground) \
        -background $astk::ihm(couleur,menu_background)
      $m2 entryconfigure 0 -font $astk::ihm(font,lablst)
      for {set j 0} {$j < $astk::config(nb_serv)} {incr j} {
         set j1 [expr $j + 1]
         $m2 add radiobutton
         $m2 entryconfigure $j1 -label $astk::config($j,nom) -font $astk::ihm(font,lablst) -variable astk::profil($var,fich,$i,serv) -command {modprof}
      }
      $tfic.lig($i,serv) configure -font $astk::ihm(font,lablst) -pady 0
      [lindex [$tfic.lig($i,serv) configure -menu] 4] configure -type
      $tfic.lig($i,serv).menu configure
      def_context $tfic.lig($i,serv) 305
   # nom
      entry $tfic.lig($i,nom) -width 40 -font $astk::ihm(font,val) -textvariable astk::profil($var,fich,$i,nom)
      $tfic.lig($i,nom) configure -validate key -vcmd {modprof}
      if { $var == "surcharge" && $astk::profil(agla) == "oui"
       && ($astk::profil($var,fich,$i,type) == "exec"
        || $astk::profil($var,fich,$i,type) == "cmde"
        || $astk::profil($var,fich,$i,type) == "ele") } {
         bind $tfic.lig($i,nom) <1>        { }
         bind $tfic.lig($i,nom) <2>        { }
         bind $tfic.lig($i,nom) <Double-1> { }
         bind $tfic.lig($i,nom) <3>        { }
      } else {
         bind $tfic.lig($i,nom) <1>        { bind_1_nom %W }
         bind $tfic.lig($i,nom) <2>        { bind_1_nom %W }
         bind $tfic.lig($i,nom) <Double-1> { bind_dble_nom %W }
         bind $tfic.lig($i,nom) <3>        { bind_3_nom %W %X %Y }
      }
      def_context $tfic.lig($i,nom) 302
   # ul
      if { $var == "etude" } {
         entry $tfic.lig($i,ul) -width 2 -justify right -font $astk::ihm(font,val) -textvariable astk::profil($var,fich,$i,UL)
         $tfic.lig($i,ul) configure -validate key -vcmd {modprof}
         def_context $tfic.lig($i,ul) 303
      }
   # donnee
      checkbutton $tfic.lig($i,donnee) -offvalue 0 -onvalue 1 \
         -variable astk::profil($var,fich,$i,donnee) -command {modprof}
      def_context $tfic.lig($i,donnee) 306
   # resultat
      if { $var == "etude" || $var == "tests" || $var == "surcharge" } {
         checkbutton $tfic.lig($i,resultat) -offvalue 0 -onvalue 1 \
            -variable astk::profil($var,fich,$i,resultat) -command "action_surch_res $var $i ; modprof"
         def_context $tfic.lig($i,resultat) 307
      }
   # compress
      if { $var == "etude" } {
         checkbutton $tfic.lig($i,compress) -offvalue 0 -onvalue 1 \
            -variable astk::profil($var,fich,$i,compress) -command "action_compress $var $i ; modprof"
         def_context $tfic.lig($i,compress) 308
      }
   # mise en forme de la grille
      set i1 [expr $i + 1]
      for {set iw 0} {$iw < [llength $lcols]} {incr iw} {
         set wid [lindex $lcols $iw]
         grid $tfic.lig($i,$wid) -row $i1 -column $iw -sticky ew -ipady 0
      }
   }
}

# event : clic sur nom de fichier
#################################################################
proc bind_1_nom { w } {
   set ch [liste_getsel $w]
   set var  [lindex $ch 0]
   set i    [lindex $ch 1]
   if { $ashare::dbg >= 5 } {
      ashare::log "<DEBUG> (bind_1_nom) sel(old,$var,$i) = [lindex $astk::sel(filename) 0]"
   }
}

# event : bouton droit sur un fichier => affiche le popup menu
#################################################################
proc bind_3_nom { w x y } {
   bind_1_nom $w
   set var  $astk::sel(liste)
   set i    $astk::sel(indice)
   tk_popup $astk::ihm(popup) $x $y
}

# event : double-clic sur nom de fichier
#################################################################
proc bind_dble_nom { w } {
   set ch [liste_getsel $w]
   set var  [lindex $ch 0]
   set i    [lindex $ch 1]
   if { $astk::profil($var,fich,$i,nom) != "" } {
      ashare::file_open typ
   } else {
      set msg [ashare::mess ihm 25]
      tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok -icon info
      change_status $msg
   }
}

# chemin de base
# fenetre_liste : contient la liste des fichiers à raffraichir
# var : etude, tests...
#################################################################
proc chemin_base { fenetre_parent fenetre_liste var } {
   label $fenetre_parent.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 21]
   entry $fenetre_parent.pth -font $astk::ihm(font,val) -textvariable astk::profil(path_$var)
   $fenetre_parent.pth configure -validate key -vcmd {modprof}
   bind $fenetre_parent.pth <FocusIn> "add_chbase $var"
   bind $fenetre_parent.pth <FocusOut> "sub_chbase $var"
   def_context $fenetre_parent.pth 301

# bouton ouvrir le chemin de base
   button $fenetre_parent.ouvrir \
      -image [image create photo -file $astk::icon(openR)] -bd 0 \
      -command "ouvrir_chemin_base $var"
#      -command "ouvrir_chemin_base $var ; liste_fich $fenetre_liste 0 $var"
   pack $fenetre_parent.lbl -side left
   pack $fenetre_parent.pth -side left -fill x -expand 1
   pack $fenetre_parent.ouvrir -side right
# bind
   def_context $fenetre_parent.ouvrir 195
}

# ouvrir chemin de base
#################################################################
proc ouvrir_chemin_base { var } {
   add_chbase $var
   set iret [ashare::selecteur nserv dir type "" $astk::profil(path_$var) "R"]
   if { $iret == 0 } {
      set astk::profil(serv_$var) $nserv
      set astk::profil(path_$var) $dir
      sub_chbase $var
   }
}

# modif des fichiers
#################################################################
proc add_chbase { var } {
# on ajoute le chemin actuel aux noms de fichiers
   for {set i 0} {$i<$astk::profil($var,nbfic)} {incr i 1} {
      set astk::profil($var,fich,$i,nom) [abspath $var $astk::profil($var,fich,$i,nom)]
   }
# partage du même chemin de base pour sources et surcharge
   if { $var == "sources" } {
      set astk::profil(path_surcharge) $astk::profil(path_$var)
      add_chbase surcharge
   }
}

# retourne le chemin absolu
#################################################################
proc abspath { var path } {
   if { [string index $path 0] != "/" } {
      set path [file join $astk::profil(path_$var) $path]
   }
   regsub -all {/\./} $path "/" path
   return $path
}

# retourne le chemin relatif par rapport au chemin de base
#################################################################
proc relpath { var path } {
   # retire l'éventuel / à la fin
   regsub "/$" $astk::profil(path_$var) "" astk::profil(path_$var)
   if { $astk::profil(path_$var) != "" } {
      regsub "^$astk::profil(path_$var)/" "$path" "./" path
   }
   return $path
}

# modif des fichiers
#################################################################
proc sub_chbase { var } {
   modprof
# substitutions
   if { $astk::profil(path_$var) != "" } {
      for {set i 0} {$i<$astk::profil($var,nbfic)} {incr i 1} {
         set astk::profil($var,fich,$i,nom) [relpath $var $astk::profil($var,fich,$i,nom)]
      }
   }
# partage du même chemin de base pour sources et surcharge
   if { $var == "sources" } {
      set astk::profil(path_surcharge) $astk::profil(path_$var)
      sub_chbase surcharge
   }
}

# icones pour une liste
#################################################################
proc liste_icone { fenetre_icone fenetre_liste var } {
# bouton nouveau
   button $fenetre_icone.nouveau -image [image create photo -file $astk::icon(new)] \
         -bd 0 -command "nouv_act $fenetre_liste $var"
   pack $fenetre_icone.nouveau -pady 3 -padx 3
# bouton ouvrir
   button $fenetre_icone.ouvrir -image [image create photo -file $astk::icon(openF)] \
         -bd 0 -command "parcourir_act $fenetre_liste $var"
   pack $fenetre_icone.ouvrir -pady 3 -padx 3
# bouton detruire
   button $fenetre_icone.detruire -image [image create photo -file $astk::icon(delete)] \
         -bd 0 -command "detr_act $fenetre_liste"
   pack $fenetre_icone.detruire -pady 3 -padx 3
   bind $fenetre_icone.detruire <3> "bind_3_detruire %W %X %Y $var $fenetre_liste"
   
# bouton editer
   if { $var != "surcharge" } {
      button $fenetre_icone.editer -image [image create photo -file $astk::icon(edit)] \
            -bd 0 -command "edit_act $fenetre_liste"
      pack $fenetre_icone.editer -pady 3 -padx 3
      def_context $fenetre_icone.editer 194
   }

# flèches haut et bas
   if { $var == "etude" || $var == "sources" || $var == "tests" } {
      button $fenetre_icone.haut -image [image create photo -file $astk::icon(uparrow)] \
          -bd 0 -command "move_act $fenetre_liste -1"
      pack $fenetre_icone.haut -pady 3 -padx 3
      button $fenetre_icone.bas -image [image create photo -file $astk::icon(downarrow)] \
          -bd 0 -command "move_act $fenetre_liste +1"
      pack $fenetre_icone.bas -pady 3 -padx 3
   }
# bind
   def_context $fenetre_icone.nouveau 109
   def_context $fenetre_icone.ouvrir 192
   def_context $fenetre_icone.detruire 193
}

# action nouveau
#################################################################
proc nouv_act { fenetre_liste var } {
   # interaction avec l'agla
   set ideb 0
   if { $var == "surcharge" && $astk::profil(agla) == "oui" } {
      set ideb 3
   }
   modprof
   set i $astk::profil($var,nbfic)
   if { $ashare::dbg >= 5 } {
      ashare::log "<DEBUG> (nouv_act) $fenetre_liste $var => astk::profil($var,fich,$i,XXX)"
   }
   set astk::profil($var,fich,$i,nom) ""
   set astk::profil($var,fich,$i,serv) $astk::config($astk::profil(serv_$var),nom)
   set astk::profil($var,fich,$i,type) $astk::UL($var,$ideb,nom)
   set astk::profil($var,fich,$i,FR) "F"
   incr astk::profil($var,nbfic)
   liste_fich $fenetre_liste [expr $astk::profil($var,nbfic) - 1] $var
   set_UL $i $ideb $var
}

# action ouvrir
#################################################################
proc parcourir_act { fenetre_liste var } {
# interaction avec l'agla
   set ideb 0
   if { $var == "surcharge" && $astk::profil(agla) == "oui" } {
      set ideb 3
   }
   modprof
   set iret [ashare::selecteur nserv nfich type "" $astk::profil(path_$var) "FR"]

   if { $iret == 0 } {
      set astk::profil($var,fich,$astk::profil($var,nbfic),serv) $astk::config($nserv,nom)
      set astk::profil($var,fich,$astk::profil($var,nbfic),FR) $type
      if { $ashare::dbg >= 4 } {
         ashare::log "<DEBUG> (parcourir_act) selection : $nfich sur $nserv de type $type"
      }
   # substitutions du chemin de base
      if { $astk::profil(path_$var) != "" } {
         regsub "^$astk::profil(path_$var)/" $nfich "./" nfich
      }
      set astk::profil($var,fich,$astk::profil($var,nbfic),nom) $nfich
      
      set astk::profil($var,fich,$astk::profil($var,nbfic),donnee) 0
      set astk::profil($var,fich,$astk::profil($var,nbfic),resultat) 0
      set astk::profil($var,fich,$astk::profil($var,nbfic),compress) 0

      # determine l'extension du fichier
      set ext [file extension $nfich]
      if { $ext == ".gz" } {
         set astk::profil($var,fich,$astk::profil($var,nbfic),compress) 1
         set ext [file extension [file rootname $nfich]]
      }
      if { $ext == "" } {
         set ext ".[file tail $nfich]"
      }

      # positionner le type et l'UL en fonction de l'extension
      # par defaut, on met le premier type
      set_UL $astk::profil($var,nbfic) $ideb $var
      set astk::profil($var,fich,$astk::profil($var,nbfic),type) $astk::UL($var,$ideb,nom)
      set astk::profil($var,fich,$astk::profil($var,nbfic),UL) $astk::UL($var,$ideb,num)
      set nlib ""
      if { [regexp {^\.([0-9]+)$} $ext mat1 nlib] } {
         set ext ".libr"
      }
      set found 0
      # cherche extension == type
      for { set ic 0 } { $ic < $astk::UL($var,nbre) } { incr ic } {
         # si .hist == .hist ou ".histor" commence par '.hist'
         if { [string tolower $ext] == ".$astk::UL($var,$ic,nom)" } {
            set astk::profil($var,fich,$astk::profil($var,nbfic),type) $astk::UL($var,$ic,nom)
            set_UL $astk::profil($var,nbfic) $ic $var
            set found 1
            break
         }
      }
      if { $found == 0 } {
         # cherche extension.startswith(type)  ('histor'.startswith('hist'))
         for { set ic 0 } { $ic < $astk::UL($var,nbre) } { incr ic } {
            # si .hist == .hist ou ".histor" commence par '.hist'
            if { [string first ".$astk::UL($var,$ic,nom)" [string tolower $ext]] > -1 } {
               set astk::profil($var,fich,$astk::profil($var,nbfic),type) $astk::UL($var,$ic,nom)
               set_UL $astk::profil($var,nbfic) $ic $var
               set found 1
               break
            }
         }
      }
      if { $found == 0 } {
         # cherche type.find(extension) >= 0  ('mmed'.find('med'))
         for { set ic 0 } { $ic < $astk::UL($var,nbre) } { incr ic } {
            # si .hist == .hist ou ".histor" commence par '.hist'
            if { [string first [string tolower [string range $ext 1 end]] $astk::UL($var,$ic,nom)] > -1
            } {
               set astk::profil($var,fich,$astk::profil($var,nbfic),type) $astk::UL($var,$ic,nom)
               set_UL $astk::profil($var,nbfic) $ic $var
               set found 1
               break
            }
         }
      }
      #
      if { $nlib != "" && $var == "etude" } {
         set astk::profil($var,fich,$astk::profil($var,nbfic),UL) $nlib
      }
      incr astk::profil($var,nbfic)
      liste_fich $fenetre_liste [expr $astk::profil($var,nbfic) - 1] $var
   }
}

# action detruire
#################################################################
proc detr_act { fenetre_liste } {
   set var $astk::sel(liste)
   set i   $astk::sel(indice)
   if { $var != "" && $i != "" && $astk::profil($var,nbfic) > 0 } {
      modprof
      detruit_entree $var $fenetre_liste $i
   # interaction avec l'agla
      if { $var == "surcharge" } {
         raffr_agla_surch
      }
      liste_fich $fenetre_liste $i $var
   } else {
      set msg [ashare::mess ihm 25]
      tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok -icon info
      change_status $msg
   }
}

# action clic droit sur le bouton détruire
#################################################################
proc bind_3_detruire { w x y var fenetre_liste } {
   #set var $astk::sel(liste)
   ashare::log "#XXX DELETE_ALL $w, $x:$y $fenetre_liste / $var"
   set iret [ tk_messageBox -message [ashare::mess ihm 390] \
      -title [ashare::mess ihm 143] -type yesno -icon question ]
   if { $iret == "yes" && $astk::profil($var,nbfic) > 0 } {
      modprof
      set nbfic $astk::profil($var,nbfic)
      for {set i 0} {$i < $nbfic} {incr i} {
         detruit_entree $var $fenetre_liste 0
      }
   # interaction avec l'agla
      if { $var == "surcharge" } {
         raffr_agla_surch
      }
   }
}

# détruit l'entrée de la liste numéro i
#################################################################
proc detruit_entree { var fenetre_liste i} {
   incr astk::profil($var,nbfic) -1
   for {set j $i} {$j < $astk::profil($var,nbfic)} {incr j 1} {
      set j1 [expr $j + 1]
      set astk::profil($var,fich,$j,nom)      $astk::profil($var,fich,$j1,nom)
      set astk::profil($var,fich,$j,serv)     $astk::profil($var,fich,$j1,serv)
      set astk::profil($var,fich,$j,type)     $astk::profil($var,fich,$j1,type)
      set astk::profil($var,fich,$j,UL)       $astk::profil($var,fich,$j1,UL)
      set astk::profil($var,fich,$j,donnee)   $astk::profil($var,fich,$j1,donnee)
      set astk::profil($var,fich,$j,resultat) $astk::profil($var,fich,$j1,resultat)
      set astk::profil($var,fich,$j,compress) $astk::profil($var,fich,$j1,compress)
      set astk::profil($var,fich,$j,FR)       $astk::profil($var,fich,$j1,FR)
   }
   unset astk::profil($var,fich,$astk::profil($var,nbfic),nom)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),serv)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),type)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),UL)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),donnee)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),resultat)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),compress)
   unset astk::profil($var,fich,$astk::profil($var,nbfic),FR)
   # détruit les widgets associés à la dernière ligne
   set lcols [colonnes_fich $var]
   for {set iw 0} {$iw < [llength $lcols]} {incr iw} {
      set wid [lindex $lcols $iw]
      grid forget $fenetre_liste.lig($astk::profil($var,nbfic),$wid)
   }
}


# action où il faut simuler une resélection
#################################################################
proc reselect_act { fenetre_liste err } {
   set var $astk::sel(liste)
   set i   $astk::sel(indice)
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (reselect_act) selection : var=$var ind=$i sel=$astk::sel(filename)"
   }
   set iret 1
   if { $var != "" && $i != "" } {
      # forcer une resélection, car  astk::sel(filename) ne contient pas
      # ce qui a pu être tapé dans la zone
      bind_1_nom $fenetre_liste.lig($i,nom)
      if { $astk::profil($var,fich,$i,nom) != "" } {
         set iret 0
      }
   }
   if { $iret != 0 && $err != "" } {
      set msg [ashare::mess ihm $err]
      tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok -icon info
      change_status $msg
   }
   return $iret
}

# action editer
#################################################################
proc edit_act { fenetre_liste } {
   set iret [reselect_act $fenetre_liste 25]
   if { $iret == 0 } {
      ashare::file_open edit
   }
}

# action déplacer vers le haut (sens = -1) / bas (sens = +1)
#################################################################
proc move_act { fenetre_liste sens } {
   set iret [reselect_act $fenetre_liste 175]
   if { $iret == 0 } {
      set var $astk::sel(liste)
      set i   $astk::sel(indice)
      if { $var != "" && $i != "" && $astk::profil($var,nbfic) > 0 } {
         set j [expr $i + $sens]
         if { $j >= 0 && $j < $astk::profil($var,nbfic) } {
            swap_line $var $i $j
            # sélection de la nouvelle position
            bind_1_nom $fenetre_liste.lig($j,nom)
            focus -force $fenetre_liste.lig($j,nom)
         }
      }
   }
}

#astk::profil(...,fich,$i,nom)  = nom du fichier
#astk::profil(...,fich,$i,serv) = serveur hébergeant ce fichier
#astk::profil(...,fich,$i,type) = type du fichier
#astk::profil(...,fich,$i,UL)   = UL du fichier
#astk::profil(...,fich,$i,donnee)   = en donnee
#astk::profil(...,fich,$i,resultat) = en resultat
#astk::profil(...,fich,$i,compress) = compressé
#astk::profil(...,fich,$i,FR)       = F/R fichier ou répertoire

proc swap_line { var i j} {
   ashare::log "swap_line $i $j"
   foreach kw { nom serv type UL donnee resultat compress FR } {
      set tmp($kw)                       $astk::profil($var,fich,$i,$kw)
      set astk::profil($var,fich,$i,$kw) $astk::profil($var,fich,$j,$kw)
      set astk::profil($var,fich,$j,$kw) $tmp($kw)
   }
}

# affecte le numero de l'UL et flag par defaut
#################################################################
proc set_UL { nli choix var } {
   set astk::profil($var,fich,$nli,UL) $astk::UL($var,$choix,num)
# on positionne les flags DRC selon le type
   if { [regexp D+ $astk::UL($var,$choix,def)] == 1 } {
      set astk::profil($var,fich,$nli,donnee) 1
   } else {
      set astk::profil($var,fich,$nli,donnee) 0
   }
   if { [regexp R+ $astk::UL($var,$choix,def)] == 1 } {
      set astk::profil($var,fich,$nli,resultat) 1
   } else {
      set astk::profil($var,fich,$nli,resultat) 0
   }
   # on ne modifie pas le flag C s'il y a déjà un nom de fichier
   if { $astk::profil($var,fich,$nli,nom) == "" || $astk::profil($var,fich,$nli,nom) == ".gz" } {
      if { [regexp C+ $astk::UL($var,$choix,def)] == 1 } {
         set astk::profil($var,fich,$nli,compress) 1
      } else {
         set astk::profil($var,fich,$nli,compress) 0
      }
   }
   # s'assurer que la ligne a été remplie
   if { $astk::profil($var,nbfic) > $nli } {
      action_compress $var $nli
   }
}

# retourne un nom par défaut en fonction du type choisi
#################################################################
proc get_valeur_defaut { nom_init ext_init type ul } {
   if { $type == "libr" } {
      regsub "\\.$ext_init\$" $nom_init ".$ul" def
   } elseif { $type == "base"
           || $type == "bhdf"
           || $type == "repe"
           || $type == "forlib" } {
      set def [file join [file dirname $nom_init] $type]
   } elseif { $type == "exec" } {
      set def [file join [file dirname $nom_init] "aster.exe"]
   } elseif { $type == "cmde" } {
      set def [file join [file dirname $nom_init] "commande"]
   } elseif { $type == "ele" } {
      set def [file join [file dirname $nom_init] "elements"]
   } elseif { $type == "mmed" } {
      regsub "\\.$ext_init\$" $nom_init ".mail.med" def
   } elseif { $type == "rmed" } {
      regsub "\\.$ext_init\$" $nom_init ".resu.med" def
   } else {
      regsub "\\.$ext_init\$" $nom_init ".$type" def
   }
   return $def
}

# insert un nom par défaut en fonction du type choisi
#################################################################
proc valeur_defaut { } {
   set var $astk::sel(liste)
   set i   $astk::sel(indice)
   if { $astk::profil(nom_profil) == [ashare::mess ihm 27] } {
      return
   }
   set def [get_valeur_defaut $astk::profil(nom_profil) "astk" $astk::profil($var,fich,$i,type) $astk::profil($var,fich,$i,UL)]
# enlève le chemin de base
   if { $astk::profil(path_$var) != "" } {
      set def "./[file tail $def]"
   }
   set astk::profil($var,fich,$i,serv) $astk::config($astk::profil(serv_profil),nom)
   set astk::profil($var,fich,$i,nom) $def
   action_compress $var $i
}

# construit le popup menu
# en cas d'insertion ou suppression voir aussi tkselecteur.CreateMenu
#################################################################
proc create_popup { m } {
   menu $m -tearoff 0 -bd 1 \
        -foreground $astk::ihm(couleur,menu_foreground) \
        -background $astk::ihm(couleur,menu_background)
   $m add command -label [ashare::mess ihm 169] -font $astk::ihm(font,labmenuB) -command {ashare::file_open typ}
   $m add command -label [ashare::mess ihm 171] -font $astk::ihm(font,labmenu)  -command {ashare::file_open edit}
   $m add command -label [ashare::mess ihm 179] -font $astk::ihm(font,labmenu)  -command {ashare::file_print_to}
   $m add separator
   $m add cascade -menu $m.opw -label [ashare::mess ihm 170] -font $astk::ihm(font,labmenu) -state disabled
   $m add command -label [ashare::mess ihm 252] -font $astk::ihm(font,labmenu)  -command {valeur_defaut}
   $m add command -label [ashare::mess ihm 82] -font $astk::ihm(font,labmenu)   -command {ashare::file_terminal}
   $m add separator
   $m add command -label [ashare::mess ihm 172] -font $astk::ihm(font,labmenu)  -command {ashare::file_prop}
}

# complète le popup menu
#################################################################
proc complete_popup { pop } {
   set mopw $pop.opw
   catch { destroy $mopw }
   menu $mopw -tearoff 0 -bd 1 \
        -foreground $astk::ihm(couleur,menu_foreground) \
        -background $astk::ihm(couleur,menu_background)
# tableau inverse
   for {set j 0} {$j < $astk::outils(nb)} {incr j} {
      set astk::inv(outil,$astk::outils($j,nom)) $j
      if { $ashare::dbg >= 5 } {
         ashare::log "<DEBUG> (complete_popup) inv(outil,$astk::outils($j,nom)) = $j"
      }
   }
# outils standard
   set nb [expr [llength $astk::ihm(outils)] / 3]
   set nn 0
   for {set i 0} {$i < $nb} {incr i} {
      set out  [lindex $astk::ihm(outils) [expr $i * 3]]
      set ctxt [lindex $astk::ihm(outils) [expr $i * 3 + 1]]
      set ilab [lindex $astk::ihm(outils) [expr $i * 3 + 2]]
      set test -1
      catch {set test $astk::inv(outil,$out)}
      # si l'outil n'est pas configuré : disabled
      set etat "disabled"
      if { $test >= 0 || [lsearch $astk::ihm(outils_autocfg) $out] > -1 } {
         set etat "normal"
         incr nn
      }
      if { $ilab != 0 } {
         set lab [ashare::mess ihm $ilab]
      } else {
         set lab $out
      }
      $mopw add command -font $astk::ihm(font,labmenu) -label $lab \
         -command "run_tool $out" -state $etat
   }
# outils perso
   # combien ?
   set nbp [expr $astk::outils(nb) - $nn + [llength $astk::ihm(outils_autocfg)]]
   if { $nbp > 0 } {
      $mopw add separator
      for {set j 0} {$j < $astk::outils(nb)} {incr j} {
         if { [lsearch $astk::ihm(outils) $astk::outils($j,nom)] == -1} {
            $mopw add command -font $astk::ihm(font,labmenu) -label $astk::outils($j,nom) \
               -command "run_tool $astk::outils($j,nom)"
         }
      }
   }
   if { $nb > 0 || $nbp > 0 } {
      $pop entryconfigure [ashare::mess ihm 170] -state normal
   } else {
      $pop entryconfigure [ashare::mess ihm 170] -state disabled
   }
}

# recupere le nom du fichier et son serveur selectionnés
#################################################################
proc liste_getsel { w {set "yes"} } {
   set txtvar [$w cget -textvariable]
   regexp {astk::profil\((.*),(.*),(.*),(.*)\)} $txtvar mat1 var fich ind mc
   set tmp $astk::profil($var,fich,$ind,$mc)
   if { [string index $tmp 0] != "/" } {
      set tmp [file join $astk::profil(path_$var) $tmp]
   }
   regsub -all {/\./} $tmp "/" tmp
   set serv $astk::profil($var,fich,$ind,serv)
   if { $set == "yes" } {
      set astk::sel(liste) $var
      set astk::sel(indice) $ind
      set astk::sel(filename) [list $tmp]
      set astk::sel(servname) $serv
   }
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (liste_getsel) $astk::sel(liste) $astk::sel(indice) $astk::sel(filename) $astk::sel(servname)"
   }
   list lret
   lappend lret $var
   lappend lret $ind
   lappend lret $tmp
   lappend lret $serv
   return $lret
}

# action quand on coche/decoche compress
#################################################################
proc action_compress { var i } {
   # numéro du type dans astk::UL, et types "FR" possibles
   set typdef "X"
   set nul 0
   for {set nul 0} {$nul < $astk::UL($var,nbre)} {incr nul} {
      if { $astk::profil($var,fich,$i,type) == $astk::UL($var,$nul,nom) } {
         set typdef $astk::UL($var,$nul,FR)
         break
      }
   }
   # si le type n'est pas compressible, on decoche immédiatement
   if { $astk::UL($var,$nul,cpr) == 0 } {
      set astk::profil($var,fich,$i,compress) 0
   }
   # ajoute/supprime .gz si le type Fichier est possible
   if { [regexp F $typdef] } {
      regsub {\.gz *$} $astk::profil($var,fich,$i,nom) "" astk::profil($var,fich,$i,nom)
      if { $astk::profil($var,fich,$i,compress)
        && $astk::UL($var,$nul,cpr) } {
         regsub { *$} $astk::profil($var,fich,$i,nom) ".gz" astk::profil($var,fich,$i,nom)
      }
   }
}

# action quand on coche/decoche 'resultat' dans les produits de surcharge
#################################################################
proc action_surch_res { var i } {
   if { $var != "surcharge" } {
      return
   }
   # liste des types de sources associés au résultat
   switch -exact -- $astk::profil($var,fich,$i,type) {
      exec -
      forlib {
         set lsrc [list f f90 c]
      }
      cmde {
         set lsrc [list capy]
      }
      ele {
         set lsrc [list cata]
      }
      default {
         set lsrc [list]
      }
   }
   # on coche/décoche les sources présents
   for {set j 0} {$j < $astk::profil(sources,nbfic)} {incr j} {
      if { [lsearch -exact $lsrc $astk::profil(sources,fich,$j,type)] > -1 } {
         set astk::profil(sources,fich,$j,donnee) $astk::profil($var,fich,$i,resultat)
      }
   }
}