###########################################################################
# Fichier config.tcl 
###########################################################################

#f config.tcl - gestion de la configuration de l'editeur (preferences,
#f              fichier de config utilisateur,)

package provide stead 2.0

# te:create_dir - A REMPLACER PAR   file mkdir $dir
# te:edit_user_file - edite le fichier steadrc ou en propose un par defaut
# te:cmd:Source - Ask for , and source a file
# te:save_prefs -- Nouvelle version en développement (diam le 29/10/99)
# text_updateChunk -- retourne une texte dont un bloc est remplacé


## te:create_dir - A REMPLACER PAR   file mkdir $dir
# 
# crée le récursivement le répertoire $d s'il n'existe pas. (Brent Welch)
# 
proc te:create_dir {d} {
    file mkdir $d
    stead:log -title "Creating directory $d"  "Done."
}


## stead:editUserFile - edite le fichier steadrc ou en propose un par defaut
# 
# Modif diam le 29/10/99 (simplification et nettoyage !
# 
proc stead:editUserFile {} {

    global stead

    # Le fichier utilisateur n'existe pas ou est vide : on propose
    # de recopier le modèle
    if {![file exists $stead(userfile)] || [file size $stead(userfile)] == 0} {
   
        set msg "Your configuration file doesn't exist or is empty.\
                    \n\nDo you want to copy default file\
                    \nin  $stead(userlib) ?"
        
        # Dans tous les cas,on crée le répertoire pour steadrc
        te:create_dir $stead(userlib)

        set reply [stead:messageBox                    \
                -type yesnocancel                       \
                -default yes                            \
                -message $msg                           \
                -title  "Try it !"                      \
        ]
        switch -exact -- $reply {
            yes {
                # Copie du fichier et edition
                file copy -force $stead(userfile_proto) $stead(userfile)
                stead $stead(userfile) 
            }
            no  {
                # edition d'un fichier vide
                stead $stead(userfile) 
                
            }
            default {
                # annulation
                return
            }
        }
    }    
    stead $stead(userfile) 
}

## te:cmd:Source - Ask for , and source a file
# 
proc te:cmd:source {} {
    global stead
    set prompt_result [xtk_fsBox -prompt "Source TCL file :"]
    if {$prompt_result != {}} then {
        xtcl_source  $prompt_result
    }
}

## te:save_prefs -- Nouvelle version en développement (diam le 29/10/99)
# 
# 
# écrit les préférences utilisateurs dans le fichier $stead(userfile)
#
proc te:save_prefs {} {

    global stead
    global EDITPREFS
    
    # BIDOUILLE (diam 21/06/02)
    # On commence par mettre à jour la fonte du texte qui peut avoir
    # été modifiée directement (grossis, diminuée en en gras)
    # 
    set EDITPREFS(textfont) [$stead(text) cget -font]
    
    # les marqueurs délimitant le morceau de texte du fichier steadrc
    # qui sera automatiquement mis à jour par cette procédure :
    set prefix "PREFERENCES UTILISATEUR"
    set suffix "FIN DES PREFERENCES UTILISATEUR"
    
    set prefixPat "^\[ \t]*#+\[ \t]*$prefix\[ \t]*\$"
    set suffixPat "^\[ \t]*#+\[ \t]*$suffix\[ \t]*\$"
    
    # Construction du morceau de texte à sauvegarder
    set allPrefs [lsort [array names EDITPREFS]]
    
    set    newChunk ""
    append newChunk "# $prefix \n\n"
    
    append newChunk "# Ne rien modifier entre ces deux marqueurs : \n"
    append newChunk "#      \"$prefix\" et \"$suffix\"\n"
    append newChunk "# Ce texte serait écrasé à chaque sauvegarde"
    append newChunk                            " des préférences\n"
    append newChunk "# (par le menu \"Config/Save Current Preference\")\n"
    append newChunk "\n"
    
    # en prévoie une adentation des chaque affectation
    foreach pref $allPrefs {
        append newChunk "   [list set EDITPREFS($pref)  $EDITPREFS($pref)]\n"
    } ;# endforeach
    append newChunk "\n"
    append newChunk "# $suffix"
    
    # On s'assure que le fichier utilisateur existe
    if {![file exists $stead(userfile)]} {
        te:create_dir $stead(userlib)
        exec touch $stead(userfile)
    }
    # # set old_steadrc_txt [read_file $stead(userfile)]
    set old_steadrc_txt [file_read $stead(userfile)]
  
    set new_steadrc_txt    [text_updateChunk $old_steadrc_txt \
            $prefixPat $suffixPat $newChunk]
  
    # # write_file  $stead(userfile) $new_steadrc_txt
    file_write  $stead(userfile) $new_steadrc_txt
}


## text_updateChunk -- retourne une texte dont un bloc est remplacé
# 
# <inText> <prefPattern> <suffPattern> <chunkText>
#     retourne une chaine dans laquelle le bloc de texte compris 
#     entre les regexps <prefPattern> et <suffPattern> est remplacé 
#     par la chaine <chunkText>.
#     Si la première patterne n'est pas trouvée, la chaine est ajoutée
#     à la fin du résultat.
#     Tous les espaces et return finaux sont effacés.
# 
# Historique 
# 
# 03/09/97: diam si le marqueur suffixe n'existe pas : ce qui suit le 
#           préfixe est concervé au lieu d'etre supprimé !
# 03/09/97: diam création à partir de file:getMaj
#           prend du texte et sort du texte
# 
# Exemple :
# 
#   # On récupère une version mise à jour du .cshrc
#   set cshrcNewTxt    [text_updateChunk $cshrcText \
#           $up(prefPat) $up(suffPat) $up(chunkText)]
# 
proc text_updateChunk {inText prefPattern suffPattern chunkText} {

    # on fera précéder la chaine de mise à jour par deux return 
    # ce qui donnera UNE SEULE ligne vide
    set chunkText \n\n$chunkText
    
    # initialisation du text correspondant au texte modifié
    set outText ""
    
    # contiendra ce qui suit le préfixe. Utile si on ne trouve pas 
    # le suffixe : toute la fin du texte pourrait etre supprimée 
    # par erreur.
    set oldChunk ""
    
    # ou on est ? (where vaut before | inside | after)
    set where "before"

    foreach line [split $inText \n] {

        # dans les lignes qui suivent, les cas les plus probables se 
        # produiront dans l'ordre
        switch -exact $where {

          before {
              if ![regexp $prefPattern $line] {
                  # on se contente de recopier les premières lignes
                  append outText $line\n
                  continue
              } else {
                  # on entre dans la zone à mettre à jour
                  # on va donc rajouter le bloc de texte à mettre à jour
                  # (en controlant le nombre de return)
                  set where "inside"
                  set outText "[string trimright $outText]$chunkText\n"
                  continue
              }
          }

          inside {
              if ![regexp $suffPattern $line] {
                  # Cette ligne devrait etre ignorée puisqu'elle a déja 
                  # été mise à jour .. à condition que le marqueur de fin 
                  # existe bien !!!
                  append oldChunk $line\n
                  continue
              } else {
                  # on sort de la zone de mise à jour
                  set where "after"
                  continue
              }
          }

          after {
              # on contente de recopier les dernières lignes
              append outText $line\n
              continue
          }
          
          default {
              # impossible (:-)
              error "$were inconnu ; doit-être before | inside | after\
                     (procédure text_updateChunk)"
          }
        } ;# endswitch

    } ;# endforeach

    # On supprime les espaces et return finaux :
    set outText [string trimright $outText]
    
    # Au cas ou on n'aurait pas trouver la ligne préfixe 
    # (cas d'un fichier n'ayant jamais été mis à jour),
    # on ajoute la mise à jour à la fin
    if {$where == "before"} {
        append outText $chunkText
    }
    # Au cas ou on n'aurait pas trouver la ligne suffixe 
    # (l'utilisateur l'a supprimé par erreur),
    # on ajoute ce qui suivait le marqueur préfixe
    if {$where == "inside"} {
        append outText $oldChunk
    }
    
    return $outText
    
} ;#endproc text_updateChunk
# ./

