# gct-mode.tcl - mode for editing gct code
#
# Modif :
# diam (24/11/02) : création à partir du mode fortran
# Cyril Couet (xx/10/02) : spécif du mode)
#
######################################################################

global stead

proc mode_gct_init {} {

    global EDITPREFS stead
    

    # Les commandes à exécuter si on quitte ce mode
    set stead(mode,cleanupCmds) [list]

    # Quelques préférences globales :
    set EDITPREFS(autobreak)     0
    set EDITPREFS(autoindent)    0          ;# Interdit l'auto indent

    # define the prefix for comment
    set EDITPREFS(prefix) "** "

    
    ####################################################################
    # menu de navigation START
    #
    # CECI SERA REFONDU AU NIVEAU DE STEAD
    #
    global TE_MODE_SEARCH_STRING TE_MODE_NAVIG_SHOW_TEXT
    set TE_MODE_SEARCH_STRING      {(?n)^\* ([A-Z]{5}.{0,23})}
    set TE_MODE_NAVIG_SHOW_TEXT    "modules"

    proc te:mode:navig_label_hook {t} {
        global TE_MODE_SEARCH_STRING

        regexp $TE_MODE_SEARCH_STRING $t intitule nom
        return $nom
    }
    # Commenté par diam le 05/02/03
    # proc te:mode:navig_sort_hook {l} {
    #     # Pour trier le menu de navigation par ordre alphabétique
    #     return [lsort -command te:mode:sort_command $l]
    # }
    
    # menu de navigation END
    ####################################################################


    # Une liste de fichier fréquement éditer pour ce mode
    #
    # (à personaliser par l'administrateur système ou par l'utilisateur)
    # On peut utiliser les métacaracteres ou les variables d'environnement)
    #
    # L'utilisateur pourra préciser cette variable dans son fichier steadrc
    # Il peut aussi positionner la varible d'environnement STEAD_GCT_FILES
    #
    #
    if {![info exists stead(mode,gct,favorFiles)]} {
        set stead(mode,gct,favorFiles) {
            $::env(STEAD_DCT_FILES)
            $::env(MY_PROJECT)/matlab/iterpenduleps.gct
            ~/matlab/iteration/principal2.gct
        }
    }
    
    ####################################################################
    # Gestion des majuscules START
    # 
    # (fonctionne conjointement avec la procédure 
    # xtext_insertFilter_hook définie plus bas
    # 
    set stead(switchCase) 1
    # A FAIRE : passer par un bindtag spécifique au mode "gct"
    bind all <Caps_Lock> {
        set stead(switchCase) [expr !$stead(switchCase)]
        # puts "stead(switchCase)=$stead(switchCase)"
    }
    
    lappend stead(mode,cleanupCmds) [list bind all <Caps_Lock> {}]
    lappend stead(mode,cleanupCmds) [list set stead(switchCase) 0]
    
    ## xtext_insertFilter_hook -- 
    # 
    # w : nom du widget text
    # file : nom du fichier en cours d'édition
    # stringToInsert : chaine sur le point d'etre insérée
    # 
    proc xtext_insertFilter_hook { w  stringToInsert } {
        global stead
        if {$stead(switchCase)} {
            # On permute la casse du caractere 
            # # # return [string toupper $stringToInsert]
            return [string_toggleCase $stringToInsert]
        } else {
            return $stringToInsert
        }        
    }
    proc string_toggleCase { inStr } {
        # Dans le cas ou la chaine à insérer contient plusieurs catacteres
        # on les retourne inchangé
        # 
        if {[string length $inStr] > 1} {
            return $inStr
        }
        
        
        # On permute la casse du caractere 
        if {[string is upper $inStr]} {
            set outStr [string tolower $inStr]
        } elseif {[string is lower $inStr]} {
            set outStr [string toupper $inStr]
        } else {
            # On doit traiter séparément chaque caractere
            set outStr ""
            foreach char [split $inStr ""]   {
                if {[string is upper $char]} {
                    append outStr [string tolower $char]
                } elseif {[string is lower $char]} {
                    append outStr [string toupper $char]
                } else {
                    # Ce n'est pas une lettre : pas de changement
                    append outStr $char
                }     
            }
        }
        return $outStr
    }
    # Gestion des majuscules END
    ####################################################################
    
      

} ;# endproc gctMain

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

    lappend stead(mode,cleanupCmds) \
                        [list xtext_style $w delete $stead(mode)]


    # Les modules sont de la forme :
    #
    # * LIBRI xxxx
    #
    xtext_style $w define $stead(mode) module {
        -type regexpLine
        -config {-foreground #FF0000}
        -pat {^\* ([A-Z]{5})}
    }

    # Les buffers d'entrée (champs 15-16 : 2 caractères ou bien "==")
    #
    xtext_style $w define $stead(mode) input {
        -type regexpLine
        -config {-foreground #800080}
        -pat {^\* [A-Z]{5}.{7}(..)}
    }

    # Les buffers de sortie (champs 23-24 : 2 caractères ou bien "++")
    #
    xtext_style $w define $stead(mode) output {
        -type regexpLine
        -config {-foreground #008080}
        -pat {^\* [A-Z]{5}.{15}(..)}
    }

    # Un description de fichier (de la forme FILE=/discar/JOBS/COUET/DATA/test)
    #
    xtext_style $w define $stead(mode) filePath {
        -type regexpLine
        -config {-foreground #FF0060}
        -pat {^ .{29}FILE=(\w/)}
        -pat {^ .*FILE=(.+)}
    }


    # Le style "keylist2" définit une patterne des mots clé commençant en
    # colonne 31
    #
    # set prePat {                              }
    set prePat {^. .{28}}
    set keylist2 {
       [A-Z0-9]+
    }

    # Inhiber par Cyril (il aime pas mes belles couleurs :-)
    #
    # xtext_style $w define $stead(mode) keylist2 [list \
    #     -type wordList                      \
    #     -config {-foreground blue}               \
    #     -prePat $prePat                          \
    #     -postPat {\M}                            \
    #     -values $keylist2                        \
    # ]

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

    # Les caracteres spéciaux mis en valeur : (, ), =, ',', ...
    xtext_style $w define $stead(mode) specialChars {
        -type regexpLight
        -config {-foreground #D00}
        -pat {[\(\),=]}
    }

    # Style comment  : commentaire gct
    # Tout ce qui commence par ** est du commentaire
    # (sauf les lignes commençant par  "** PA" ou "** GV" )
    xtext_style $w define $stead(mode) comment {
        -type regexpLine
        -config {-foreground #060}
        -pat {^(\*\*(?! (PA|GV)).*)}
    }

    # Les meta-commentaires (** PATCH et ** GV)
    # 
    # diam (05/02/03) intégration de la modif de Cyril :
    # 
    # xtext_style $w define $stead(mode) metaComment {
    #     -type regexpLine
    #     -config {-foreground #F40}
    #     -pat {^(\*\*( PA| GV).*)}
    # }
    xtext_style $w define $stead(mode) metaComment {
        -type regexpLine
        -config {-foreground #F40}
        -pat {^(\*\*( PA| GV| UNPA).*)}
    }

    # Détection d'erreurs
    set pat {^.{80}(.*)}
    xtext_style $w define $stead(mode) error_longLines   [list   \
        -type regexpLine                                \
        -config {-foreground yellow -background red}    \
        -pat $pat                                       \
    ]

    xtext_style $w enable $stead(mode)
}


## gct_GetHelp :  aide sur le mode GCT :
#
proc mode_gct_GetHelp {} {
  set help {

   GCT mode (Created by Diam in Nov 2002)

    This mode shows :
    ---------------

        - lines containing patches in red

        - module names in red

        - input buffer in purple

        - output buffer in light green

        - text in column 80 and onwards in yellow on red background

        - comments in dark green

    
    General functions
    -----------------
    
        - By default, text is entered in uppercase characters. 
          Press the shift key to enter text in lowercase characters
        
        - The preset tabulations correspond with the input buffer, output 
          buffer and parameters columns
        
        - To select a column, either
                - drag via MB3
             or - select the upper left character wih MB1 and then select the 
                  lower right character with 'Shift + MB3'
                      
    Note these slight anomalies :
    -----------------------------

        - When you click on the "Modules" button, the resulting display is 
          partially cropped.

        - The first column is the 0 column. As a consequence, parameters start 
          at column 30 instead of 31.

        - When you double-click to select a full line, the cursor should not
          be placed in column 0.
          

                Please, communicate any other remarks or problems 
                   concerning stead to your support department.
                   
  }

  return $help
}

## mode_gvt_defineSabbrev --
# Aliases for GCT mode
#
# Pour plus d'informations sur la création d'alias : voir la doc en début
# du fichier electric-alias.tcl
# Voici les procédure utiles à l'intérieur d'une spécification d'alias
#
# defAlias
#   (option  -sol si declenchable seulement en début de ligne)
#   crée la définition de l'alias. Cette définition pourra
#   faire appel au commandes suivante
#
# askVar >string> <varName>:
#   demande et mémorise par exemple le nom d'une chaine de caractere
#   en vue de son utilisation dans l'alias expansé
#
# getVar <varName> :
#   retourne la valeur de la "variable" créée sous ce nom
#
# setStop :
#   crée un marque de stop dans l'alias (pour passer d'un champs à l'autre
#   apres l'expansion de l'alias)
#
# i :
#   Extrait la chaine d'indentation actuelle de l'utilisateur
#
#
#
proc mode_gct_defineSabbrev {} {

    global stead

    set mode $stead(mode)

    # On peut construire un alias interactif en plus étape dans une variable
    # temporaire
    set    tmp {[askVar "procedure name" NAME]}
    append tmp {## [getVar NAME] -- [setStop]\n}
    append tmp {# \n}
    append tmp {# arguments:\n}
    append tmp {# \n}
    append tmp {#   - \n}
    append tmp {# \n}
    append tmp {# results:\n}
    append tmp {# \n}
    append tmp {# \n}
    append tmp {# \n}
    append tmp {# examples\n}
    append tmp {# \n}
    append tmp {# \n}
    append tmp {# \n}
    append tmp {proc [getVar NAME] { [setStop] } \{\n}
    append tmp {[i][setStop]\n}
    append tmp {\}\n}
    append tmp {[setStop]}
    defAlias -sol  gct proc2 $tmp

    defAlias -sol gct if      {if ([setStop]) then\n[i]endif [setStop]}
    defAlias -sol gct elseif  {elseif ([setStop]) then [setStop]}
    defAlias -sol gct else    {else \n[setStop] [setStop]}

}


## mode_gct_openModuleDoc -- Ouvre la documentation du module sélectionné...
#
proc mode_gct_openModuleDoc  {  } {
    global stead
    set w $stead(text)
    set theWord [xtext_getSel $w]
    if { ![string length $theWord]} {
        set theWord [$w get "insert wordstart" "insert wordend"]
    }
    stead:log "Running htmldoc for [string range $theWord 0 20]"
    set cmd [list exec htmldoc $theWord & ] 
    # set cmd [list exec stead $::F & ]     ;# POUT TESTER
    if {[catch {eval $cmd} msg]} {
        # On pourra faire quelque chose de plus intelligent
        # On peux par exemple avoir sélectionné un espace de trop avec le 
        # nom du module, ...
        stead:log -error $msg
    }
}

## mode_gct_stripComments -- supress all comments from the current file
# 
# 
# Principe : 
#   - On extrait toutes les lignes et on les examines
#   - Si elle ne commence pas  par "**" alors on la conserve
#   - 
# 
# 
proc mode_gct_stripComments {  } {
    global stead
    set w $stead(text)
    
    set txt [$w get 1.0 end]
    set txtNew ""
    foreach line [split $txt \n] {
    
        # 1 - Si une ligne **ne commence pas** par "**" : on la garde
        # 
        if {![regexp -- {^\*\*.*$} $line]} {
            append txtNew "$line\n"
            continue
        }
        
        # 2 - Mais si c'est un méta-commentaire : on la garde également
        # 
        if {[regexp -- {^\*\* (PA|UNPA|GV).*$} $line]} {
            append txtNew "$line\n"
            continue
        }
        
        # Comentaire standard : on l'ignore et on passe à la ligne suivante
    }
    
    # De plus on supprime les lignes vides ou ne contenant que des espaces
    regsub -all -- {\n[ \t]*\n} $txtNew "\n" txtNew
    
    # On vire aussi le blanc de début et de fin de fichier
    set txtNew [string trim $txtNew]
    
    # On remplace l'ancien text par le nouveau
    xtext_delete $w -push 1 -- 0.0 end
    xtext_insert $w -push 0 -- $txtNew
    
}


######################################################################
# define the DCT menu:
# 
proc mode_gct_defineMenu_gct {} {
    global stead

    # Création d'un menu (apres destruction s'il existe déja)
    set menubutton  .menu.$stead(mode)
    set m           .menu.$stead(mode).m

    if {[winfo exists $menubutton]} {
        destroy $menubutton
    }

    # Création d'un bouton de menu (ce qu'on voit dans la barre des menu)
    menubutton $menubutton \
            -text [string totitle $stead(mode)] \
            -menu .menu.$stead(mode).m

    lappend stead(mode,cleanupCmds) [list destroy  $menubutton]


    # On positionne ce bouton
    pack append .menu $menubutton left

    # Création d'un menu (ce qui ce déroule quand on clique sur le menubutton)
    set m [menu $m]


    # $m add command \
    #         -label {Compiler ce fichier gct} \
    #         -command {mode_gct_compilFile}
    # 
    # $m add separator

    $m add command \
            -label "Help about $stead(mode)"  \
            -command {stead -r 1  -text [mode_gct_GetHelp] }

    $m add command \
            -label "Help about selected module"  \
            -command {mode_gct_openModuleDoc }

    $m add command \
            -label "Suppress all comment from this file"  \
            -command {mode_gct_stripComments }


    ## Sous menu pour les fichiers modèles de ce mode
    $m add cascade \
            -label {Fichiers modèles}  \
            -menu "$m.files"
    # On remplis ce sous-menu avec les fichiers fovoris
    menu $m.files
    foreach file [glob -nocomplain  $stead(mode,gct,favorFiles)] {
        $m.files add command \
                 -label $file \
                 -command "stead $file"
    }


    ## Sous menu pour les fichiers gct du répertoire courant
    menu:makeEditSubmenuFromDirectory2  $m.files $m.files.[xtcl_uid]  \
           "répertoire courant"  [file dirname $stead(file)]/*.gct



    # $m add cascade \
    #         -label {Fichiers gct du répertoire courant} \
    #         -menu "$m.currentfiles"
    # menu $m.currentfiles
    # set alphaliste [lsort $FILELIST]
    # foreach {file} $alphaliste {
    #     $m.currentfiles add command \
    #         -label $file \
    #         -command [list stead [file dirname $FILENAME]/$file.m &]
    # }

}

## mode_gct_defineMenu_Templates - défini le menu Templates
#
#
proc mode_gct_defineMenu_Templates {} {
    global stead

    ####################################################################
    #
    set menubutton  .menu.templates
    set m           .menu.templates.m

    if {[winfo exists $menubutton]} {
        destroy $menubutton
    }
    # Création d'un bouton de menu (ce qu'on voit)
    menubutton $menubutton \
            -text Templates \
            -menu $m

    lappend stead(mode,cleanupCmds) [list destroy  $menubutton]

    # On positionne ce bouton
    pack append .menu $menubutton left

    # Création d'un menu (ce qui ce déroule quand on clique sur le menubutton)
    set m [menu $m]
    #
    ####################################################################


    $m add command \
            -label "Insérer un separateur \"***...\"" \
            -command {separator 1}

    $m add separator

    ######## DEBUT DE EN TEST ########

    $m add command \
            -label {bloc (TEST 1 : electricAlias-insert "proc2")} \
            -command {electricAlias-insert $stead(text) proc2}

    $m add command \
            -label {bloc (TEST 2 : electricAlias-wrap "proc2")} \
            -command {electricAlias-wrap proc2}

    $m add command \
            -label {bloc (TEST 3 : gct_insertblock_exemple "proc2")} \
            -command {gct_insertblock_exemple proc2}

    ######## FIN DE EN TEST ########

    $m add cascade -label Alias -menu $m.alias
    menu $m.alias
    foreach alias [electricAlias-softNames] {
        set tmp [string index $alias 0]
        if {$tmp == [string toupper $tmp]} {
            $m.alias add command \
              -label $alias \
              -command "electricAlias-insert $stead(text) [te:no_interp $alias]"
        }
    }
}

## mode_gct_compilFile -
#
# Lancement de Matlab depuis le répertoire contenant le fichier :
# cette procedure lance Matlab dans le repertoire du fichier edite
#
proc mode_gct_compilFile {} {
    global stead
    # set dir [file dirname $stead(file)]
    # cd $dir
    error " Fonctionnalité pas encore implémentée !!"
    # return [exec xterm -e matlab &]
}


## gct_insertblock_exemple - exemple de procédure spécifique d'insertion
#
#
#
proc gct_insertblock_exemple {alias} {

    global EDITPREFS stead
    set w $stead(text)

    # 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 [$w 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
    $w mark set insert "insert lineend"

    # On recupere le texte de la ligne courante :
    set currentIndent [$w 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]} {
         $w insert insert "\n[i]"
         set currentIndent [i]
    }

    electricAlias-wrap $alias

} ;# endproc separator

## separator -- insère N (=1) lignes de séparation (ligne commentaire)
#
# Insère "Nblines" lignes (défaut : 1) correspondant au separateur
# souhaité ;
#
# Cette procédure est automatiquement liée au raccourci <Meta-1>
#
proc separator {{NbLines 1}} {
   insert_fill_lines "*" $NbLines
}

## stead:tabkey_inside_hook --
#
# Gestion des tabulation pour le mode gct
# (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
    #
    # retourne par exemple 63.6
    set ins [$t index insert]
    #
    # retourne la colonne courante : 6
    set currentCol [lindex [split $ins .] 1]

    # La liste des colonnes souhaitées
    # set tabStops [list 15 23 31 41 79 88 94 100]
    set tabStops [list 14 22 30 40 78 87 93 99]

    # On cherche le nombre N d'espaces a inserer *****A COMPLETER*****
    # newCol sera l'indice de la future colonne
    foreach tabStop $tabStops {
        if {$tabStop > $currentCol} {
            break
        }
    }

    # La chaine d'espace à insérer
    set str [string repeat " " [expr {$tabStop - $currentCol} ] ]

    # On insere le nombre d'espace précédement calculé :
    xtext_insert $w $str
}

########################################################################
## Les procédure quasi standard de stead
########################################################################

## stead:modeStart_gct - lancement du mode gct
#
# A FAIRE : modififier stead et tous les modes de façon à pouvoir
# changer de mode en appelant les procédures :
#   stead:modeQuit $oldMode
#   stead:modeStart $newMode
#
proc stead:modeStart_gct {} {
    mode_gct_init

    mode_gct_defineMenu_gct
    mode_gct_defineMenu_Templates
    mode_gct_defineSabbrev
    mode_gct_defineStyles
}
## stead:modeQuit_gct - Nettoyage quand on quitte ce mode
#
proc stead:modeQuit_gct {} {
    catch {eval [join $::stead(mode,cleanupCmds) ";"]}
}

## Cette procédure est appelé automatiquement (sera refondu)
proc stead:modeCleanup {} {
    stead:modeQuit_gct
}

# Ceci sera géré automatiquement par stead (via auto_load)
stead:modeStart_gct
#./

