# fortran-mode.tcl - mode for editing fortran code
# 
# Modif :
# diam (05/12/96) : refonte
# R.Gras (19/11/96) : on impose une indent à 8 espaces (indent_string)
# R.Gras (20/11/96) : complète TE_MODE_SEARCH_STRING par les mots clés 
#                     "program|PROGRAM"
# 
######################################################################

global stead

proc fortranMain {} {
   
   global MODE EDITPREFS stead
   global TE_MODE_SEARCH_STRING TE_MODE_NAVIG_SHOW_TEXT

   # On utilisera de plus en plus stead(mode) a la place de MODE.
   set stead(mode) $MODE 
   
   # Quelques préférences globales :
   set EDITPREFS(autobreak)     0
   set EDITPREFS(autoindent)    1          ;# Force l'auto indent
   set EDITPREFS(indent_string) {        } ;# 8 espaces pour l'indentation
   
   # define the prefix for c mode
   set EDITPREFS(prefix) "C "
   
   
   # Définition du menu de navigation
   # set part1 \
   # "\n\[ \t\]*(subroutine|SUBROUTINE|function|FUNCTION|program|PROGRAM)"
   # set part2 "\[ \t\]*(\[a-zA-Z0-9_\]*)"
   
   set part1 \
      "\n\[ \t\]*(subroutine|SUBROUTINE|function|FUNCTION|program|PROGRAM)"
   set part2 "\[ \t\]+(\[^\n\]*)"
   
   set TE_MODE_SEARCH_STRING $part1$part2
   set TE_MODE_NAVIG_SHOW_TEXT "subroutines"
   
   ########################################################################
   # cette variable contient une liste de fichiers à éditer dans ce mode
   if {![info exists stead(modeFORTRAN,sampleFiles)]} {
       set stead(modeFORTRAN,sampleFiles) {
          /insert/here/you/favorite/list/of
          /fortan/modeles
          see_file_make-mode.tcl_in_stead_library
       }
   }
   
   fortranBuildMenus
   fortranDefineAlias
   mode_fortran_defineStyles

} ;# endproc fortranMain

########################################################################
# procédure de définition des couleurs des couleurs
########################################################################
proc mode_fortran_defineStyles {} {
    global stead
    upvar #0 stead(text) w

    # Le style "keylist1" définit une patterne de reconnaissance des mots clé 
    # "important" (i.e. modif de structure et autre...)
    # 
    # 
    set keylist1 {
      program subroutine function block data include goto continue
      call return stop end       
    }
    set keylist1 [mode_fortran_makeSparseWordList $keylist1]

    xtext_style $w define fortran keylist1 [list \
        -type wordListLight                      \
        -config {-foreground red}                \
        -prePat {(?i)\m}                         \
        -postPat {\M}                            \
        -values $keylist1                        \
    ]

    # Le style "keylist2" définit une patterne de reconnaissance des mots clé 
    # "courants" du fortran :
    set keylist2 { 
       logical integer real character real "double precision" eval 
       if then else elseif endif open
       do enddo while
       .or. .and. .false. .true. .eq. .ne. .le.
    }
    set keylist2 [mode_fortran_makeSparseWordList $keylist2]

    xtext_style $w define fortran keylist2 [list \
        -type wordListLight                      \
        -config {-foreground blue}               \
        -prePat {(?i)\m}                         \
        -postPat {\M}                            \
        -values $keylist2                        \
    ]

    # Le style "keylist3" définit les oprération boolean (.and., .or., ..) 
    set keylist3 { 
       or and false true eq ne le
    }
    # set keylist3 [mode_fortran_makeSparseWordList $keylist2]

    xtext_style $w define fortran keylist3 [list \
        -type wordListLight                      \
        -config {-foreground blue}               \
        -prePat {(?i)\.}                         \
        -postPat {\.}                            \
        -values $keylist3                       \
    ]

    # Style quote  : guillemets "doubles" ou 'simples'
    xtext_style $w define fortran quote {
        -type regexpLight
        -config {-foreground #700}
        -pat {(".*?"|'.*?')}
    }

    # Style comment  : commentaire fortran (cxxxx ou Cxxxx)
    # Un commentaire est une ligne DÉBUTANT par "c" ou "C" ou "*".
    xtext_style $w define fortran comment {
        -type regexpLine
        -config {-foreground #060}
        -pat {^([cC\*].*)}
    }

    xtext_style $w enable fortran
}

########################################################################
## mode_fortran_makeSparseWordList -
# 
# retourne une liste de patterne régulière en fonction d'une liste de mot 
# clé dans les condition suivante :
# - chaque lettre peut etre suivie d'espaces ou de tabulation
# - le caractere point est précédé de backslash
# Exemple 
#   call => c\*a\*l\*l\*
#   .false. => \.\*f\*a\*l\*s\*e\*\.
# 
# En fortran, le mot clé :
#   "open" 
# peut s'écrire : 
#    "O p  en" 
# ou même : 
#   "OpE   n"
# 
# Remarque : un traitement spécial est effectué pour le caractere "."
#            par insertion d'un "\" 
# 
proc mode_fortran_makeSparseWordList {keylist} {
    set newKeyList [list]
    foreach key $keylist {
        set keyPat ""
        foreach char [split $key {}] {
            if {[string match . $char]} {
                append keyPat {\.\s*}
            } else {
                # append keyPat "\[$char[string toupper $char]\]\[ \t\]*"
                append keyPat "$char\\s*"
            } 
        } 
        lappend newKeyList $keyPat
    } 
    return ${newKeyList}
}

###########################################################################
# aide sur le mode FORTRAN :
###########################################################################

proc fortran_GetHelp {} {
  set help {
    aide du mode FORTRAN prototype :
    
    Le menu "proc" permet d'accéder rapidement à une procédure du fichier.
    
    A titre d'exemple trois alias electriques bidons sont prédéfinis
    On peut les activer en tapant par exemple "ps" (pour process) suivi du 
    raccourci <Meta-tab> (ou <alt-tab> suivant les claviers).
    
    alias          résultat
    ^^^^^          ^^^^^^^^
    <meta-1>       insertion d'un séparateur "c-----..."
    
    for            boucle for
    foreach        boucle foreach
    while          boucle while
    if             if
    
    proc           bloc interactif procedure
  }
  return $help
}

########################################################################
# fortranDefineAlias --
# Aliases for FORTRAN mode
# 
proc fortranDefineAlias {} {

  global stead MODE 
  
  # Pour simplifier l'écriture des electricAlias : on déclare
  # les variables M, B, E et V au niveau local pour 
  # 
  #      M :  Marque temporaire
  #      B :  début de postcommande 
  #      E :  fin de postcommande
  #      V :  Inclusion d'une variable TCL
  # 
  electricAlias-use8bitsCars

  
  electricAlias-def ${M}fortran ${M}fortran ${M}fortran
  ########## DEBUT DE EN TEST ########
  # la procédure appelées par [i] retourne la chaine d'indentation courante
  set tmp "[i]block data $M\n[i]  ${M}\n[i]end\n[i]$M"
  electricAlias-def ${M}fortran bloc $tmp
  electricAlias-def ${M}fortran bl $tmp
  
  electricAlias-def ${M}fortran subroutine "[i]subroutine $M () \n[i]end $M"
  electricAlias-def ${M}fortran sub "[i]subroutine $M () \n[i]end $M"
  ########## FIN DE EN TEST ########
  
  
  electricAlias-def ${M}fortran do "do $M \n\tenddo $M"
  electricAlias-def ${M}fortran while "do while ($M) \n\tenddo $M"
  
  electricAlias-def ${M}fortran subroutine "subroutine $M () $M"
  electricAlias-def ${M}fortran function "function $M () $M"
  electricAlias-def ${M}fortran common "common \/$M\/ $M"
  electricAlias-def ${M}fortran include "include \"$M\" $M"
  electricAlias-def ${M}fortran dimension "dimension $M $M"
  electricAlias-def ${M}fortran logical "logical $M $M"
  electricAlias-def ${M}fortran character "character $M $M"
  electricAlias-def ${M}fortran format "$M\tformat() $M"
  electricAlias-def ${M}fortran external "external $M $M"
  electricAlias-def ${M}fortran integer2 "integer\*2 $M $M"
  electricAlias-def ${M}fortran integer4 "integer\*4 $M $M"
  electricAlias-def ${M}fortran real4 "real\*4 $M $M"
  electricAlias-def ${M}fortran real8 "real\*8 $M $M"

#   electricAlias-def ${M}fortran subroutine "subroutine $M () \nend $M"
  electricAlias-def ${M}fortran function "function $M () \nend $M"
  
#   electricAlias-def ${M}fortran program "program $M  \nend $M"
electricAlias-def ${M}fortran program "\tprogram $M  \n\tend $M"

  electricAlias-def ${M}fortran common "common \/$M\/ $M"
  electricAlias-def ${M}fortran include "include \"$M\" $M"
  electricAlias-def ${M}fortran dimension "dimension $M $M"
  electricAlias-def ${M}fortran logical "logical $M $M"
  electricAlias-def ${M}fortran character "character $M $M"
  electricAlias-def ${M}fortran format "${M}format() $M"
  electricAlias-def ${M}fortran external "external $M $M"
  electricAlias-def ${M}fortran integer2 "integer\*2 $M $M"
  electricAlias-def ${M}fortran integer4 "integer\*4 $M $M"
  electricAlias-def ${M}fortran real4 "real\*4 $M $M"
  electricAlias-def ${M}fortran real8 "real\*8 $M $M"
  ##################
  electricAlias-def ${M}fortran implicit "\timplicit none\n "
  electricAlias-def ${M}fortran complex "complex $M $M"
  electricAlias-def ${M}fortran complex16 "complex\*16 $M $M"
  electricAlias-def ${M}fortran suite "      1 $M $M"
  electricAlias-def ${M}fortran return "return $M $M"
  electricAlias-def ${M}fortran end "end $M $M"
  
  electricAlias-def ${M}fortran open "open ($M,file=) $M"
  electricAlias-def ${M}fortran opendir "open ($M,file=,access='direct',recl=) $M"
  
  electricAlias-def ${M}fortran if      "if ($M) then\n\tendif $M"
  electricAlias-def ${M}fortran elseif  "elseif ($M) then $M"
  electricAlias-def ${M}fortran else    "else \n$M $M"
  
} ;# endproc fortranDefineAlias



################################################################################
# definit le libelle des elements de navigation pour le mode fortran
################################################################################


proc te:mode:navig_sort_hook {l} {
  return [lsort -command te:mode:sort_command $l]
}
 

 
######################################################################
# define the FORTRAN menu:
proc fortranBuildMenus {} {
global stead MODE 

  te:mode:make_menu $MODE
  
  .menu.$MODE.m add command -label {search proc} \
     -command {te:tcl:cmd:search_proc}
  .menu.$MODE.m add separator
  .menu.$MODE.m add command -label {Refresh Colors} \
     -command {refresh_colors} \
     -accelerator {<Control-c>}
  .menu.$MODE.m add command -label {Cancel Colors} \
     -command {cancel_colors}
  .menu.$MODE.m add separator
  .menu.$MODE.m add command -label "Aide du mode $MODE"  \
     -command {stead -r 1  -text [fortran_GetHelp] }  
  .menu.$MODE.m add cascade -label {Files sample}  \
     -menu ".menu.$MODE.m.files"
     
  menu .menu.$MODE.m.files
  foreach {file} $stead(modeFORTRAN,sampleFiles) {
     .menu.$MODE.m.files add command -label $file \
        -command "exec $stead(exe) $file &"
  } ;# endforeach
  
    
  
  ###########################################################################
  # Création et remplissage de menu template
  ###########################################################################
  
  te:mode:make_menu {templates}
  
  .menu.templates.m add command -label "Insérer un separateur" \
                        -command {separator }
  
  ######## DEBUT DE EN TEST ########
  .menu.templates.m add command -label {bloc (expension de l'alias "bloc")} \
                                -command {electricAlias-wrap bloc}
  .menu.templates.m add command -label {bloc (procédure indépendant)} \
                                -command {fortranTempl_block}
  ######## FIN DE EN TEST ########
  
  .menu.templates.m add separator
  
  .menu.templates.m add command -label {En court de complément} \
                                -state disabled \
                                -command {electricAlias-wrap foreach}
                                  
  .menu.templates.m add separator
  
  .menu.templates.m add separator
  
  # Menu alias construit automatiquement : 
  # Celui-ci a seulement pour but de lister (pour mémoire) les
  # abreviations dynamiques disponibles
  
  .menu.templates.m add cascade -label Alias -menu .menu.templates.m.alias
  menu .menu.templates.m.alias
  
  foreach alias [electricAlias-softNames] {
     .menu.templates.m.alias add command \
             -label $alias \
             -command "electricAlias-insert $stead(text) [te:no_interp $alias]"
  }

} ;# endproc fortranBuildMenus



###########################################################################
# les procedures d'insertion de template --
# 
# 
proc fortranTempl_block {} {
global EDITPREFS
   
   # On mémorise l'état de l'éditeur en vu d'un undo éventuel
   xtext_pushState
   
   # On cherche la colonne courante du point d'insertion
   set ins [.main.t index insert]    ;# retourne par exemple 53.6
   set lin [lindex [split $ins .] 0] ;# retourne la ligne courante : 53
   set col [lindex [split $ins .] 1] ;# retourne la colonne courante : 6
   
   # On place le point d'insertion en fin de la ligne courante
   .main.t mark set insert "insert lineend"
   
   # On recupere le texte de la ligne courante :
   set currentIndent [.main.t get "insert linestart" "insert lineend"]
   
   # Si la ligne courante contient autre chose que des espaces :
   # on commence une nouvelle ligne avec indentation :
   if {![regexp "^\[ \t\]*\$" $currentIndent]} {
      .main.t insert insert "\n[i]"
      set currentIndent [i]
   }

   electricAlias-wrap bl

} ;# endproc separator

###########################################################################
# separator --
# 
# Cette procédure est automatiquement liée au raccourci <Meta-1>
# Insère une ligne séparatrice pour le fortran  "c------...."
# en s'assurant qu'en est en debut de ligne (sinon un return #
# supplémentaire est inséré)
# 
# parametre : aucun
# effet de bord : utilise 
proc separator {} {

   # On associe la globale $EDITPREFS(fillcolumn) a la locale fillcolumn
   # qui est une préférence contenant le nombre de caracteres par ligne
   upvar #0 EDITPREFS(fillcolumn) fillcolumn
   
   # Initialisation de la chaine à insérer
   set txt ""
   
   # Si on n'est pas en debut de ligne, on prévoit un return
   if {![string match "*.0" [.main.t index insert]]} {
      append txt \n
   }
   
   # On construit le texte a inserer
   append txt "c"
   while {[string length $txt] < $fillcolumn} {
       append txt "-"
   } ;# endwhile
   append txt \n
   
   # insertion du texte dans le widget (en tenant compte du Undo)
   ins $txt
   
} ;# endproc separator

########################################################################
# stead:tabkey_inside_hook -- 
# Gestion des tabulation pour le mode fortran 
# (appelé par la procedure stead:tabkey)
# 
# Dans cet exemple, chaque appuie sur <Tab> génère des espaces de facon
# a positionner le curseur dans les positions suivante :
#    7  10  13  16  etc etc   de 3 en 3 
# (le premier caractere etant en colonne 0 => 8 espace pour la 
# premiere colonne)
# 
proc stead:tabkey_inside_hook {t} {
    global EDITPREFS
    global stead
    upvar 0 stead(text) w
    
    # On cherche la colonne courante du point d'insertion
    set ins [$t index insert]         ;# retourne par exemple 63.6
    set col [lindex [split $ins .] 1] ;# retourne la colonne courante : 6
    
    # On cherche le nombre N d'espaces a inserer *****A COMPLETER*****
    # newCol sera l'indice de la future colonne 
    set newCol 7
    while {$col >= $newCol} {
        incr newCol 3
    }
    # La chaine d'espace à insérer 
    set str [string repeat " " [expr {$newCol - $col}]]
    
    # On insere le nombre d'espace précédement calculé :
    xtext_insert $w $str
}

######################################################################
# cleanup for tcl mode
######################################################################

proc stead:modeCleanup {} {
    global MODE
    te:mode:destroy_menu $MODE
    te:mode:destroy_menu templates
    
    # Pour quitter le mode proprement on doit detruire les procedures installees
    # stead:returnkey_pre_hook et stead:spacebar_post_hook
    catch  {rename stead:returnkey_post_hook {}}
    catch  {rename stead:spacebar_post_hook {}}
}
fortranMain
#./
