# java-mode.tcl - mode for editing java code
# 
# Modif :
# diam (02/12/05) : création à partir du mode de java
# 
######################################################################

global stead

proc phpMain {} {
   
   global stead 
   global MODE EDITPREFS FILENAME
   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 
   
   if [info exists FILENAME] {
       set stead(fileToCompile) $FILENAME
   } else {
       set stead(fileToCompile) ""
   }

   
   # Quelques préférences globales :
   set EDITPREFS(autobreak)     0
   set EDITPREFS(autoindent)    1          ;# Force l'auto indent
   
   # define the prefix for c mode
   set EDITPREFS(prefix) "// "
   set EDITPREFS(suffix) " //"
   
   
   # Définition du menu de navigation
   set TE_MODE_NAVIG_SHOW_TEXT "objects_methods"
   set method "\n\[ \t\]*(function|public|abstract|class|static|private)\[^\n\]+"
   set TE_MODE_SEARCH_STRING $method
   
   # cette variable contient une liste de fichiers à éditer dans ce mode
   if ![info exists stead(modePHP,sampleFiles)] {
       set stead(modePHP,sampleFiles) {
          /insert/here/you/favorite/list/of
          /php/modeles.php
       }
   }
   
   
   phpDefineAlias
   phpBuildMenus
   mode_php_defineStyles
   
} ;# endproc phpMain


########################################################################
# procédure de définition des couleurs des couleurs
########################################################################
proc mode_php_defineStyles {} {
    global stead
    upvar #0 stead(text) w
    
    # "keylist1"  définit une patterne de reconnaissance des mots clé 
    # "important" (i.e. modif de structure et autre...)
    # 
    xtext_style $w define php keylist1 {
        -type wordListLight
        -config {-foreground red}
        -values {
            public protected private  static final
            main class interface import function
            require  require_once include include_once
            return catch try throw throws exit die
        }
    }
    xtext_style $w define php keylist1bis {
        -type regexpLight
        -config {-foreground red}
        -pat {<\?php|\?>}
    }
    
    # "keylist2"  définit une patterne de reconnaissance des mots clé 
    # "courants" du php :
    # 
    xtext_style $w define php keylist2 {
        -type wordListLight
        -config {-foreground blue}
        -values {
            if else elseif while do for switch  case
            new this
            assert
        }
    }
    
    # les labelssont  utilisés comme préfix dans les boubles. 
    # il cassent la structure (utilisation dans break et continue)
    # Donc, les instructions de la forme 
    #   myLabeL: while (xxx)
    #       ...
    #       break myLabe;
    # sont en rouge sur fond jaune :
    # 
    xtext_style $w define php label {
        -type regexpLine
        -config {-foreground red -background yellow}
        -pat {^\s*(\w+\s*:\s*(for|while|do))}
    }
    # ceci coloriait par erreur une chaine du type "breakHour"
    # xtext_style $w define php gotos {
    #     -type regexpLine
    #     -config {-foreground red -background yellow}
    #     -pat {((goto|break|continue)(\s+\w+)?)}
    # }
    # 
    # Ceci colorie : break , break label
    # mais mais pas xxbreak ni breakyyy
    # (grace au $ de fin de ligne au milieu de la patterne !)
    xtext_style $w define php gotos {
        -type regexpLine
        -config {-foreground red -background yellow}
        -pat {\W((goto|break|continue)(\W+|$)(\w+)?)}
    }
    
    # "keylist3"  définit une patterne de reconnaissance des mots clé 
    # correspondant à des types ou classes couramment prédéfinis :
    # 
    xtext_style $w define php keylist3 {
        -type wordListLight
        -config {-foreground blue}
        -values {
            byte short int long real float double char boolean 
            Byte Short Integer Long Real Float Double Character Boolean 
            String SringBuffer List ArrayList LinkedList Thread Event
            void null NULL true false
            Iterator
        }
    }
        
    # # xtext_style $w define php globalArrays {
    # #     -type wordListLight
    # #     -config {-foreground darkviolet}
    # #     -values {
    # #         \$GLOBALS \$_REQUEST \$_POST \$_GET \$_SERVER 
    # #     }
    # # }
    xtext_style $w define php globalArrays {
        -type regexpLine
        -config {-foreground darkviolet}
        -pat {(\$GLOBALS|\$_REQUEST|\$_POST|\$_GET|\$_SERVER|\$_SESSION)}
    }
        
    # Traitement des guillemets
    # 
    # # xtext_style $w define php {
    # #     quotes {
    # #         -type regexpLight
    # #         -config {-foreground #700}
    # #         -pat {(".*?")}
    # #     }
    # #     singleQuotes {
    # #         -type regexpLine
    # #         -config {-foreground red -font bold}
    # #         -pat {^(?:[^"]*)(")(?:[^"]*)$}
    # #     }
    # # }
    xtext_style $w define php {
        quotes {
            -type regexpLight
            -config {-foreground #700}
            -pat {(".*?")}
        }
        singleQuotes {
            -type regexpLight
            -config {-foreground #700}
            -pat {('.*?')}
        }
    }


    # erreur légère (rose claire)
    # J'en ai mare des tabulations qu'on trouve dans le code source
    # et qui perturbe l'indentation
    set COLOR_TAB 1
    if {$COLOR_TAB} {
        xtext_style $w define $stead(mode) {
            tabulation {
                -type regexpLight
                -pat {\t}
                -config {
                    -background "#FDD"
                }
            }
        }
    }
    # erreur grave et pénible en php (fond rouge)
    # 
    # $txt=<<<EOT
    #  xxx..
    #  xxx...
    # EOT;
    # 
    # Le EOT final **doit** être suivi d'un ; sans espace avant ou apres !!
    # 
    set INLINED_STRING 1
    if {$INLINED_STRING} {
        xtext_style $w define $stead(mode) {
            inlinedString {
                -type regexpLine
                -pat {^((EOT|eot|eof|EOF)($|;.+))$}
                -config {
                    -background "#F88"
                }
            }
        }
    }

    set stead(commentConfig) {-foreground #060}
    # set config  "-background green -foreground red"
    # Pour balance stead /*
    set stead(tagSpec,c_comment) [list  \
        -type    regexpPair             \
        -prePat  {/\*}                  \
        -postPat {\*/}                  \
        -config  $stead(commentConfig)   \
    ]
    xtext_style $w define php c_comment  $stead(tagSpec,c_comment)
    
    xtext_style $w define php cc_comment [list \
        -type regexpLight  \
        -pat {//.*$}       \
        -config $stead(commentConfig)
    ]
    
    xtext_style $w enable php
}



###########################################################################
# aide sur le mode PHP :
###########################################################################

proc php_GetHelp {} {
  set help {
    aide du mode PHP prototype :
    
    Les electric alias sont des raccourcis qu'on peut lancer en tapant 
    l'abbreviation suivie de <Meta-Space>
    La liste complète de ces abbréviation est définie dans le sous-menu 
    "alias" du menu Template.
    
    Quelques exemples d'alias prédéfinis :
      for            boucle for
      while          boucle while
      do             boucle while ... do
      if             if
      ife            if ...else 
      switch         switch
    
    Le menu "Template" propose quelques macros prédéfinies. Vous pouvez
    en rajouter d'autres dans le fichier de mode utilisateur (voir menu
    "Help/xxx") 
    
    
    Le menu "objects_methods" permet d'accéder rapidement à une procédure 
    du fichier.
    
    raccourci clavier      résultat
    ^^^^^^^^^^^^^^^^^      ^^^^^^^^
    <meta-1>               insertion d'un séparateur "////..."
    
  }
  return $help
}

########################################################################
# phpDefineAlias --
# Aliases for PHP mode
# 
proc phpDefineAlias {} {

  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  
    
  # Quelques petites abbrév courantes
  
  # bloc d'instruction
  electricAlias-def php bb {\{\n[i][setStop]\n\}\n}

  electricAlias-def php pub  "public "
  electricAlias-def php p    "public "
  electricAlias-def php pri "private "
  electricAlias-def php m  "main "
  electricAlias-def php v  "void "
  electricAlias-def php p  "public "
  electricAlias-def php s  "static "
  electricAlias-def php psfv  "public static final void "
  electricAlias-def php psv  "public static void "
  electricAlias-def php psf  "public static final "
  electricAlias-def php pf  "public final "
  electricAlias-def php ps  "public static "
  electricAlias-def php pv  "public void "
  electricAlias-def php const  "public static final "
  
  electricAlias-def php S  "String "
  electricAlias-def php b  "boolean "
  electricAlias-def php B  "Boolean "
  
  
  electricAlias-def php sy "synchronized"
  
  electricAlias-def php pr "System.out.print([setStop]);\n[setStop]"
  electricAlias-def php pn "System.out.println([setStop]);\n[setStop]"

  set    tmp {import php.io.*;\n}
  append tmp {import php.util.*;\n}
  electricAlias-def ${M}php imp  $tmp

  # insertion de documentation (pour phpdoc)
  set    tmp {/**\n}
  append tmp {   [setStop]\n}
  append tmp {*/}
  append tmp {[setStop]}
  electricAlias-def ${M}php doc $tmp
  electricAlias-def ${M}php d   $tmp
  
  # Déclaration de classe
  set    tmp {[askVar "class name" NAME]}
  append tmp {/**\n}
  append tmp {     La classe [getVar NAME] ...[setStop]\n}
  append tmp {   [setStop] \n}
  append tmp {*/ \n}
  append tmp {public class [getVar NAME]  \{\n}
  append tmp {[i][setStop]\n}
  append tmp {\}\n}
  append tmp {[setStop]}
  electricAlias-def ${M}php class $tmp
  electricAlias-def ${M}php c $tmp
  
  
  
  # Classe  Main contenant une fonction main()
  # Il faudrait pouvoir réutiliser les abréviation "class" et "main"
  set    tmp {/** \n}
  append tmp {[i]Classe principale de l'application\n}
  append tmp {[i][setStop] \n}
  append tmp {*/ \n}
  append tmp {public final static class Main  \{\n}
  append tmp {[i]\n}
  append tmp {[i]public static void main(String\[\] args) \{\n}
  append tmp {[i]\n}
  append tmp {[i][i][setStop]\n}
  append tmp {[i]\}\n}
  append tmp {\}\n}
  append tmp {[setStop]}
  electricAlias-def ${M}php Main $tmp
  
  # fonction  main
  set    tmp {public static void main(String\[\] args) \{\n[i][setStop]\n\} }
  append tmp { // main\n[setStop]}
  electricAlias-def ${M}php main $tmp
  
  # structure switch
  set    tmp {switch ([setStop]) \{\n}
  append tmp {[i]case : [setStop]\n}
  append tmp {[i]case : [setStop]\n}
  append tmp {[i]       break;\n}
  append tmp {[i]default : [setStop]\n\} }
  append tmp {\n[setStop]}
  electricAlias-def ${M}php switch $tmp
  electricAlias-def ${M}php swi    $tmp
  
  
  # structure if
  set    tmp {if ([setStop]) \{\n[i][setStop]\n\}}
  append tmp {\n[setStop]}
  electricAlias-def ${M}php if $tmp
  
  # structure if avec else
  set    tmp {if ([setStop]) \{\n[i][setStop]\n\}}
  append tmp { else \{\n}
  append tmp {[i][setStop]\n}
  append tmp {\}\n[setStop]}
  electricAlias-def ${M}php ife $tmp
  
  
  # boucle while
  set    tmp {while ([setStop]) \{\n[i][setStop]\n\} }
  append tmp {\n[setStop]}
  electricAlias-def ${M}php while $tmp
  electricAlias-def ${M}php w     $tmp
  
  # boucle do
  set    tmp {do \{\n[i][setStop]\n}
  append tmp {\} while ([setStop]);\n}
  append tmp {\n[setStop]}
  electricAlias-def ${M}php do $tmp
  
  # boucle for
  # set    tmp {for ([setStop];[setStop];[setStop]) \{\n}
  set    tmp {for ([setStop]) \{\n}
  append tmp {[i][setStop]\n}
  append tmp {\}\n[setStop]}
  electricAlias-def ${M}php for $tmp
  
  # alias foreach = fe
  # Iteration sur une collection par un Iterator
  # 
  set    tmp {[askVar "iterator name" IT_NAME]}
  append tmp {[askVar "local variable name" VAR_NAME]}
  append tmp {[askVar "collection name" LIST_NAME]}
  append tmp {\n}
  append tmp {// foreach ([getVar VAR_NAME], [getVar LIST_NAME]) \{...\}\n}
  append tmp {Iterator [getVar IT_NAME] = [getVar LIST_NAME].iterator();\n}
  append tmp {while ( [getVar IT_NAME].hasNext() ) \{\n}
  append tmp {[i][getVar VAR_NAME] = ([setStop VARTYPE])[getVar IT_NAME].next(); \n}
  append tmp {[i]\n}
  append tmp {[i][setStop]\n}
  append tmp {[i]\n}
  append tmp {\}\n}
  append tmp {\n}
  append tmp {[setStop]}
  electricAlias-def ${M}php fe      $tmp
  electricAlias-def ${M}php foreach $tmp
  
  # alias forall = fa
  # Iteration sur une ArrayList par boucle for
  # 
  set    tmp {[askVar "local variable name" VAR_NAME]}
  append tmp {[askVar "ArrayList name" LIST_NAME]}
  append tmp {\n}
  append tmp {// foreach ([getVar VAR_NAME], [getVar LIST_NAME]) \{...\}\n}
  append tmp {for(int i = 0; i < [getVar LIST_NAME].size(); i++) \{\n}
  append tmp {[i][getVar VAR_NAME] = ([setStop VARTYPE])[getVar LIST_NAME].get(i); \n}
  append tmp {[i][setStop]\n}
  append tmp {\}\n}
  append tmp {\n}
  append tmp {[setStop]}
  electricAlias-def ${M}php fa      $tmp
  electricAlias-def ${M}php forall  $tmp
  
  # spécifique PHP
  set    tmp {<?php> [setStop] ?>}
  electricAlias-def php  php   {<?php [setStop] ?>}
  electricAlias-def php  php2   {<?php\n[i][setStop]\n?>}

} ;# endproc phpDefineAlias



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

proc te:mode:navig_sort_hook {l} {
  return [lsort -command te:mode:sort_command $l]
}
 
#################################################################
# te:tcl:cmd:search_node - recherche la procedure selectionnee   
#################################################################

proc te:tcl:cmd:search_node {{w .main.t}} {

  set sel [xtext_getSel $w]
  if {"x$sel" == "x"} {
    stead:log -title "Tcl" -text "Please select procedure name"
  } else {
    te:tcl:cmd:go_to_node $sel $w
  }
}

#######################################################################
# te:tcl:cmd:go_to_node - selectionne la procedure $p dans le texte $t

proc te:tcl:cmd:go_to_node {p {t .main.t}} {

  global  auto_index
  set methodPat "\n\[ \t\]*(public|class|final|protected|private)$p\[ \t\]\[^\n\]*"

  stead:log -text "Searching procedure $p" -title "Tcl"
  set text [$t get 1.0 end]
  if {[regexp -indices "$methodPat" $text n]} {
    stead:log -text "procedure $p found." -title "Tcl"
    $t mark set insert "1.0 + [lindex $n 1] chars"
    catch {$t tag remove sel sel.first sel.last}    
    $t tag add sel "1.0 + [lindex $n 1] chars linestart" \
    "1.0 + [lindex $n 1] chars lineend"
    $t yview -pickplace insert
    xtext_updateFocusIn $t
    # A FAIRE :
    # xtext_applyShortHighlight $t \
    #                           "1.0 + [lindex $n 1] chars" \
    #                           "1.0 + [lindex $n 1] chars lineend"

  } else {
    stead:log -text "procedure $p not found" -title "Tcl"
    set file {}
    catch {set file [lindex $auto_index($p) 1]}
    if {"x$file" != "x"} {
      stead:log "Opening file $file"
      exec $stead(exe) $file -command "te:tcl:cmd:go_to_node $p" &
    }
  }
}
# blink
 
######################################################################
# define the php menu:
proc phpBuildMenus {} {
global stead MODE 

  te:mode:make_menu $MODE
  
  .menu.$MODE.m add command -label {make} \
        -command {te:cmd:make_file}
        
  .menu.$MODE.m add separator
  .menu.$MODE.m add command -label {g++ File} \
        -command {te:cmd:gcc_file}
  .menu.$MODE.m add command -label {g++ -g File} \
        -command {te:cmd:gcc_debug_file}
  .menu.$MODE.m add command -label {execute File} \
        -command {te:cmd:exe_file}
  .menu.$MODE.m add command -label {debug File} \
        -command {te:cmd:debug_file}
        
  .menu.$MODE.m add separator
  .menu.$MODE.m add command -label {File to Process. . .} \
        -command {te:cmd:change_c_file}
       


  .menu.$MODE.m add command -label {search selected method} \
     -command {te:tcl:cmd:search_node }
     
  .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 [php_GetHelp] }  
  .menu.$MODE.m add cascade -label {Files sample}  \
     -menu ".menu.$MODE.m.files"
     
  menu .menu.$MODE.m.files
  foreach {file} $stead(modePHP,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 1}
  
  .menu.templates.m add command -label {main...} \
                                -command {electricAlias-wrap main}
  
  .menu.templates.m add separator
  
  .menu.templates.m add command -label {Boucle for} \
                                -command {electricAlias-wrap for}
  .menu.templates.m add command -label {Boucle while} \
                                -command {electricAlias-wrap while}
  .menu.templates.m add command -label {Boucle "do...while"} \
                                -command {electricAlias-wrap do}
  .menu.templates.m add command -label {Structure switch} \
                                -command {electricAlias-wrap switch}
                                
  .menu.templates.m add command -label {Structure if} \
                                -command {electricAlias-wrap if}
  .menu.templates.m add command -label {Structure if...else} \
                                -command {electricAlias-wrap ife}
    
  
  .menu.templates.m add separator
  .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 phpBuildMenus

###########################################################################
# proc separator {number_of_lines textwidget}
# retourne une chaine correspondant au separateur souhaité 
# 
proc separator {{NbLines 1} } {
   
   insert_fill_lines "/" $NbLines 

} ;# endproc separator


########################################################################
########################################################################
# Autre procédure utiles (a deplacer plus tard)


###########################################################################
# te:cmd:change_php_file - change le fichier a compiler
#
proc te:cmd:change_php_file {} {

  global stead
  
   set prompt_result [te:prompt -text "Enter Main File" \
   -default $stead(fileToCompile) -title "php file to compil"]
   
   if { [file isfile $prompt_result] } {
     set stead(fileToCompile) $prompt_result
   } else {
     stead:log -text "invalid File Name" -title "php"
   }
}

######################################################################
# te:cmd:gcc_file - gcc file
######################################################################

proc te:cmd:gcc_file {} {
  global stead
  
  if {("x$stead(fileToCompile)" == "x") || [xtext_isDirty .main.t]} {
  
    stead:log -text "please save file first" -title "g++"
    
  } else {

    exec xterm -e g++ -o \
       [file rootname $stead(fileToCompile)].out $stead(fileToCompile) 
  }
}

######################################################################
# te:cmd:make_file - make file
######################################################################

proc te:cmd:make_file {} {
  global stead
  if {("x$stead(fileToCompile)" == "x") || [xtext_isDirty .main.t]} {
    stead:log -text "please save file first" -title "g++"
  } else {

    exec xterm -e make& 
  }
}

######################################################################
# te:cmd:gcc_debug_file - gcc file with symbolic info for debugg
######################################################################

proc te:cmd:gcc_debug_file {} {
  global stead
  if {("x$stead(fileToCompile)" == "x") || [xtext_isDirty .main.t]} {
    stead:log -text "please save file first" -title "g++ -g"
  } else {

    exec xterm -e g++ -g -o \
      [file rootname $stead(fileToCompile)].out $stead(fileToCompile) 
  }
}

######################################################################
# te:cmd:debug_file - debug the executable file with xxgdb
######################################################################

proc te:cmd:debug_file {} {
  global stead
  if {("x$stead(fileToCompile)" == "x") || [xtext_isDirty .main.t]} {
    stead:log -text "please save file first" -title "g++"
  } else {
    if [file exists [file rootname $stead(fileToCompile)].out] {
      exec xxgdb [file rootname $stead(fileToCompile)].out &
      stead:log -text "Running Command" \
               -title "xxgdb [file tail [file rootname $stead(fileToCompile)]]"
    } else {
      stead:log -text "No out File" \
               -title "xxgdb [file tail [file rootname $stead(fileToCompile)]]" 
    }
  }
}
######################################################################
# te:cmd:exe_file -  executes the output file 
######################################################################

proc te:cmd:exe_file {} {
  global stead 
  if {("x$stead(fileToCompile)" == "x") || [xtext_isDirty .main.t]} {
    stead:log -text "please save file first" -title "g++"
  } else {
    if [file exists [file rootname $stead(fileToCompile)].out] {
      exec xterm -e [file rootname $stead(fileToCompile)].out &
    } else {
      stead:log -text "No out File" \
               -title "xxgdb [file tail [file rootname $stead(fileToCompile)]]" 
    }
  }
}



######################################################################
# cleanup for php mode
######################################################################

proc stead:modeCleanup {} {
    global stead
    upvar 0 stead(text) w
    te:mode:destroy_menu $stead(mode)
    te:mode:destroy_menu templates
    xtext_style $w delete $stead(mode)    
}

phpMain
