# cc-mode.tcl - mode for editing cc code
# 
# $Id: cc-mode.tcl,v 1.1.1.1 2000/09/19 10:50:13 diam Exp $ 
# 
# Modif :
# diam (13/01/97) : refonte complète 
# diam (28/08/98) : modif de toute chaine "c++" en "cc" complète 
#                   (correction d'un bug d'index dans alias dynamique)
# diam (26/10/98) : modif pattern et nom du menu de navigation 
# 
######################################################################

global stead

proc claireMain {} {
   
   global stead 
   global MODE EDITPREFS
   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 stead(file)] {
       set stead(fileToCompile) $stead(file)
   } 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 "methods"
   # set an \[a-zA-Z0-9_\]  ;# AlphaNum
   # set w "\[ \t\]"  ;# a White space
   # # Anciennement :
   # # set method "\n\[ \t\]*(public|class|private)\[^\n\]+"
   # set method "\n$an*$w*($an+::$an+)$w*\\(\[^\n\]+"
   # set TE_MODE_SEARCH_STRING $method

   # Attention : cette patterne est définie indépendement de la coloration
   set methodPat {\n\[([\w\?!-_.*+=]+)\(}   ;# \] pour balance
   set TE_MODE_SEARCH_STRING $methodPat
   
   ########################################################################
   # cette variable contient une liste de fichiers à éditer dans ce mode
   if ![info exists stead(modeclaire,sampleFiles)] {
       set stead(modeclaire,sampleFiles) {
          /insert/here/you/favorite/list/of
          /claire/modeles.cl
       }
   }
      
   claireDefineAlias
   claireBuildMenus
   mode_claire_defineStyles
} ;# endproc claireMain



########################################################################
# procédure de définition des couleurs des couleurs
########################################################################
proc mode_claire_defineStyles {} {
    global stead
    upvar #0 stead(text) w
    
    # "method"  définition des méthodes et fonction de classe 
    # 
    xtext_style $w define claire method {
        -type regexpLine
        -config {-foreground red}
        -pat {^(\[[\w*\$+=-_./]+\().*$}
    }
    # pour balance : )]
    
    # "keylist1"  définit une patterne de reconnaissance des mots clé 
    # "important" (i.e. modif de structure et autre...)
    # 
    xtext_style $w define claire keylist1 {
        -type wordListLight
        -config {-foreground red}
        -values {
            error module load debug begin
            main class  
            break catch try
        }
    }
    xtext_style $w define claire keylist1_bis {
        -type regexpLight
        -config {-foreground red}
        -pat {->|=>|::|<:}
    }
    
    
    # "keylist2"  définit une patterne de reconnaissance des mots clé 
    # "courants" du claire :
    # 
    xtext_style $w define claire keylist2 {
        -type wordListLight
        -config {-foreground blue}
        -values {
            let for in  exists when some not
            if else while do for 
            new 
            getenv 
        }
    }
    
    # "keylist3"  définit une patterne de reconnaissance des mots clé 
    # correspondant à des types ou classes couramment prédéfinis :
    # 
    xtext_style $w define claire keylist3 {
        -type wordListLight
        -config {-foreground blue}
        -values {
            byte short integer long real bool float double char boolean 
            string set list void null true false
        }
    }
        
    # "error"  quelques patternes d'erreur courantes  
    #     
    # error_badComma :  
    # Une virgule et des commentaire (// et ;) en fin de bloc
    # un bloc se terminant par par parenthese, un crochet ou in (camme 
    # dans let..in..)
    # Ce style pouvant enblober des commentaires : il doit donc etre
    # appliqué apres le style définissant les commentaires Balance : ([
    # 
    # set pat {(,\s*(?:(?://|;)[^\n]*\n\s*)*\))}  ;# GOOD !
    set pat {(,\s*(?:(?://|;)[^\n]*\n\s*)*(?:\)|\]|in\s))}   ;# GOOD !
    # Je veux modifier pour ignorée une vigule si dans un commentaire
    # # xtext_style $w define claire error_badComma   [list \
    # #     -type regexpGlobal                               \
    # #     -config {-foreground red -font bold}             \
    # #     -pat $pat                                        \
    # # ]                   
    xtext_style $w define claire error_badComma   [list  \
        -type regexpGlobal                               \
        -config {-foreground yellow -background red}     \
        -pat $pat                                        \
    ]
    xtext_style $w define claire error_badKeyword {
        -type wordListLight
        -config {-foreground yellow -background red}
        -values {
            continue continu return int
        }
    }
     # En claire, un mot peut contenir presque n'importe quel caractere
    # Il faut donc séparer les opérateurs classiques par des espaces
    # Il faut mettre ce style avant celui définissant les guillements
    # 
    set pat {[_a-zA-Z0-9]+[-=\+\*]|[=\+\*][_a-zA-Z0-9]+}
    xtext_style $w define claire error_operatorInWord [list     \
        -type regexpLight                                       \
        -config {-foreground red}                    \
        -pat $pat                                               \
    ]
    
    # Traitement des guillemets
    # 
    xtext_style $w define claire {
        quotes {
            -type regexpLight
            -config {-foreground #700 -background white}
            -pat {(".*?")}
        }
        singleQuotes {
            -type regexpLine
            -config {-foreground red -font bold -background white}
            -pat {^(?:[^"]*)(")(?:[^"]*)$}
        }
    }

    # Traitement des opérateurs de la forme " := "
    # 
    set ops [list]
    foreach op {:= :\\+ :- :\\* :/\\+ :/ /\\+ > < >= <= = \\+ - \\* }    {
        lappend ops $op
    }
    set pat "( [join $ops " | "] )"
    # puts "pat=|$pat|"
    xtext_style $w define claire operator [list   \
        -type regexpLight                         \
        -config {-foreground #707 -background white}                \
        -pat $pat                                 \
    ]                                       


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

    xtext_style $w enable claire
}


###########################################################################
# aide sur le mode claire :
###########################################################################

proc claire_GetHelp {} {
  set help {
    aide du mode claire 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.
    
    Le reste était périmé !    
  }
  return $help
}

########################################################################
# claireDefineAlias --
# Aliases for claire mode
# 
proc claireDefineAlias {} {

  global stead  
      
  set    tmp {[askVar "method 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 {\[[getVar NAME]([setStop]): void ->\n}
  append tmp {[i][setStop]\n}
  append tmp {\]\n}
  append tmp {[setStop]}
  defAlias -sol  claire met $tmp

  
  set    tmp {let\n}
  append tmp {[i][setStop]\n}
  append tmp {[i]noComma := 0\n}
  append tmp {in (\n}
  append tmp {[i][setStop]\n}
  append tmp {[i]noComma\n}
  append tmp {)\n}
  defAlias -sol  claire let $tmp

  set    tmp {if ([setStop]) (\n}
  append tmp {[i][setStop]\n}
  append tmp {)\n}
  defAlias -sol  claire if $tmp

  set    tmp {if ([setStop]) (\n}
  append tmp {[i][setStop]\n}
  append tmp {) else (\n}
  append tmp {[i][setStop]\n}
  append tmp {)\n}
  defAlias -sol  claire ife $tmp

  set    tmp {while ([setStop]) (\n}
  append tmp {[i][setStop]\n}
  append tmp {)\n}
  defAlias -sol  claire while $tmp
  defAlias -sol  claire whi $tmp
  defAlias -sol  claire w $tmp

  set    tmp {for [setStop] in ([setStop]) (\n}
  append tmp {[i][setStop]\n}
  append tmp {)\n}
  defAlias -sol  claire for $tmp

  
  set    tmp {princ("POPOPO\\n"),}
  append tmp {\n}
  defAlias -sol  claire prc $tmp

  set    tmp {printf("POPOPO\\n"),}
  append tmp {\n}
  defAlias -sol  claire prt $tmp
  
  set    tmp {printf("VAR1=~S\\n", VAR1),}
  append tmp {\n}
  defAlias -sol  claire prt1 $tmp

  

} ;# endproc claireDefineAlias



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

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 -warning "claire: Please select method name"
  } else {
    te:tcl:cmd:go_to_node $sel $w
  }
}

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

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

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

  stead:log -text "Searching procedure $p" -title "Tcl"
  set text [$w get 1.0 end]
  if {[regexp -indices "$methodPat" $text n]} {
    stead:log -text "procedure $p found." -title "Tcl"
    $w mark set insert "1.0 + [lindex $n 1] chars"
    catch {$w tag remove sel sel.first sel.last}    
    $w tag add sel "1.0 + [lindex $n 1] chars linestart" \
    "1.0 + [lindex $n 1] chars lineend"
    $w see insert
    xtext_updateFocusIn $w
    # A FAIRE :
    # xtext_applyShortHighlight $w \
    #                           "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 TCL menu:
proc claireBuildMenus {} {
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:fileToCompile}
       


  .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 [claire_GetHelp] }  
  .menu.$MODE.m add cascade -label {Files sample}  \
     -menu ".menu.$MODE.m.files"
     
  menu .menu.$MODE.m.files
  foreach {file} $stead(modeclaire,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 foreach} \
                                -command {electricAlias-wrap foreach}
  .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 {boucle switch} \
                                -command {electricAlias-wrap switch}
                                
  .menu.templates.m add command -label {if} \
                                -command {electricAlias-wrap if}
  .menu.templates.m add command -label {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 claireBuildMenus

###########################################################################
# 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:fileToCompile - change le fichier a compiler
#
proc te:cmd:fileToCompile {} {

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

######################################################################
# 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 claire 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)
} 

claireMain




