# ada-mode.tcl - mode for editing ada code
# d'apres les sources de Maurice DIAMANTINI (diamantini@ensta.fr)
# Modifié par Yves CABON (cabon@ensta.fr) le 28/05/95 
###########################################################################
global stead
global MODE EDITPREFS 

###########################################################################
# cette variable contient une liste de fichier à éditer dans ce mode
global MODE_FAST_EDIT
set MODE_FAST_EDIT {
/usr/valid/tools/leapfrog/files/stdsrc/standard.vhd
/usr/valid/tools/leapfrog/files/stdsrc/textio.vhd
/usr/valid/tools/leapfrog/files/IEEE.src/IEEE_PKG.vhd
/usr/valid/tools/leapfrog/files/IEEE.src/IEEE_BODY.vhd
/usr/valid/tools/leapfrog/files/IEEE.src/IEEE_ARITH.vhd
}
###########################################################################
# défini le préfixe pour le mode ada (utilisé pour mettre en commentaires)
set EDITPREFS(prefix) "-- "


###########################################################################
# chaine de recherche (utilisé pour générer le menu de navigation)
global TE_MODE_SEARCH_STRING TE_MODE_SEARCH_RESERVED TE_MODE_NAVIG_SHOW_TEXT  

set part1 "\n\[ \t\]*(procedure|function)"
set part2 "\[ \t\]*(\[a-zA-Z0-9_\]*)"
set TE_MODE_SEARCH_STRING $part1$part2

set mots "(abort|abs |accept|all |and |array|at |begin|body|case|constant"
append mots "|declare|delay|delta|digits|do |else|elsif|end |entry"
append mots "|exception|exit|for |generic|goto|\[ ;\]if\[ ;\]|in |is "
append mots "|limited|loop|mod |new|not |null|of |or |others|out |package"
append mots "|pragma|private|raise|range|record|rem |renames|return"
append mots "|reverse|select|separate|subtype|task|terminate|then|type"
append mots "|use |when |while|with|xor )"
set TE_MODE_SEARCH_RESERVED $mots

set TE_MODE_NAVIG_SHOW_TEXT "procs" ;# nom de menu de navigation

# # # global COMMENT_STRING ; set COMMENT_STRING "--\[^\n\]*"
# # # # global COLOR_COMMENT  ; set COLOR_COMMENT seagreen3
# # # global COLOR_COMMENT  ; set COLOR_COMMENT green4
# # # ##############################################################################
# # # #  what is executed after the file is read (colorization)
# # # ##############################################################################
# # # proc stead:read_post_hook {filename text} {
# # #    global TE_MODE_SEARCH_STRING COMMENT_STRING COLOR_COMMENT COLOR_PROC
# # #    
# # #    te:cmd:colorise $TE_MODE_SEARCH_STRING all $COLOR_PROC
# # #    te:cmd:colorise $COMMENT_STRING all $COLOR_COMMENT
# # # }

########################################################################
########################################################################
########################################################################
# Gestion des couleurs
########################################################################
########################################################################
########################################################################
global HILIGHT_STRING HILIGHT_COLOR HILIGHT_LIST

set ABN "\[^\n\]*" ;# All But Newline
set ABLB "\[^{\]*" ;# All But Left Brace
set ABRB "\[^}\]*" ;# All But Right Brace
set MIN  {[a-z]} ;# Lettre MINuscule
set MINS {[a-z]*} ;# LettreS MINuscules
set NMIN  {[^a-z]} ;# All But Lettre MINuscule
set SPS  "\[ \n\]+" ;# SPaceS

# On définit la liste de nom de pattern à colorier dans l'ordre car 
# le dernier coloriage ecrase les coloriages précédents) : 
#set HILIGHT_LIST {}
set HILIGHT_LIST {reserved variable attribut pragma proc comment}

# les variables sont suivis de ":"
# lappend HILIGHT_LIST variable
set t1 "\n\[ \t\]*\[_A-Za-z0-9\]*"
set t2 "\[ \t\]*: "
set HILIGHT_STRING(variable) $t1$t2
set HILIGHT_COLOR(variable) green3

# les attributs predefinis sont precedes de "'"
set att1 " \[_A-Za-z0-9\]*'"
set att2 "\(ADDRESS|AFT|BASE|CALLABLE|CONSTRAINED|COUNT|DELTA|DIGITS|
append att2 EMAX|EPSILON|FIRST|FIRST_BIT|FORE|IMAGE|LARGE|LAST|LAST_BIT|
append att2 LENGTH|MACHINE_EMAX|MACHINE_EMIN|MACHINE_MANTISSA|
append att2 MACHINE_OVERFLOWS|MACHINE_RADIX|MACHINE_ROUNDS|MANTISSA|
append att2 POS|POSITION|PRED|RANGE|SAFE_EMAX|SAFE_LARGE|SAFE_SMALL|
append att2 SIZE|SMALL|STORAGE_SIZE|SUCC|TERMINATED|VAL|VALUE|WIDTH)"
set HILIGHT_STRING(attribut) $att1$att2
set HILIGHT_COLOR(attribut) violet

# colorisation des pragmas
set prag "\(CONTROLLED|ELABORATE|INLINE|INTERFACE|LIST |MEMORY_SIZE|OPTIMISE
append prag |PACK|PAGE|PRIORITY|SHARED|STORAGE_UNIT|SUPPRESS|SYSTEM_NAME)"
set HILIGHT_STRING(pragma) $prag
set HILIGHT_COLOR(pragma) magenta

# colorisation des procedures ou fonctions
set HILIGHT_STRING(proc) $TE_MODE_SEARCH_STRING
set HILIGHT_COLOR(proc) blue

# colorisation des mots reserves
set HILIGHT_STRING(reserved) $TE_MODE_SEARCH_RESERVED
set HILIGHT_COLOR(reserved) purple

# Un commentaire va de la chaine "--" jusqu'a en fin de ligne :
set HILIGHT_STRING(comment) "--\[^\n\]*"
set HILIGHT_COLOR(comment) red


########################################################################
# Cette procédure recolorise l'ensemble du fichier
proc refresh_colors {} {
   
   global HILIGHT_STRING HILIGHT_COLOR HILIGHT_LIST
   # On commence par effacer les couleur existantes
   cancel_colors
   
   foreach pat $HILIGHT_LIST {
      te:cmd:colorise $HILIGHT_STRING($pat) all $HILIGHT_COLOR($pat)
      # endfor
   }
   
} ;# endproc refresh_colors
# # # # On définit un raccourci clavier
# # # bind .main.t <Control-c> refresh_colors

########################################################################
# Cette procédure supprime les couleurs
proc cancel_colors {} {
   
   global HILIGHT_STRING HILIGHT_COLOR HILIGHT_LIST
   foreach pat $HILIGHT_LIST {
      stead:coloursResetForeground_BOF all $HILIGHT_COLOR($pat)
   }
} ;# endproc cancel_colors

########################################################################
########################################################################
########################################################################

########################################################################
# Création de ligne de séparation pour utilisation ultérieur :
set SEPARATOR_LINE ""
for {set i 1} {$i <= $EDITPREFS(fillcolumn)} {incr i} {
   append SEPARATOR_LINE "-"
}
append SEPARATOR_LINE \n
########################################################################
########################################################################
########################################################################
########################################################################
########################################################################
########################################################################
########################################################################
########################################################################

# Nom du fichier à compiler :
global FILENAME
if [info exists FILENAME] {
   set EDITPREFS(mode,ada,compilfile) $FILENAME
}
##############################################################################
#  what is executed after the file is read (colorization)
##############################################################################
proc stead:read_post_hook {filename text} {
   refresh_colors
}


# 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

# # # global EA_8bit_mark EA_8bit_var EA_8bit_begin EA_8bit_end
# # # set M $EA_8bit_mark
# # # set B $EA_8bit_begin
# # # set E $EA_8bit_end
# # # set V $EA_8bit_var


# # # # cette procedure renvoie l'indentation courante dans l'editeur
# # # proc i {} {
# # #  global EDITPREFS
# # #  return $EDITPREFS(indent_string)
# # # }

###########################################################################
# aide sur le mode ada :
###########################################################################

global ada_HELP
set ada_HELP {
aide du mode ada prototype :

alias          résultat
^^^^^          ^^^^^^^^
<meta-1>       insertion d'un séparateur "---..."
lib            "library "
ieee           library IEEE; use std_logic_1164 et std_logic_arith (3 lignes)

pk             bloc interactif "package ...;"
pkb            bloc interactif "package body ...;"
ent            bloc interactif entity...end;
arch           bloc interactif architecture 

bloc            bloc interactif "xxx : bloc xxx ... end bloc xxx;"
process (ps)    bloc interactif "xxx : process xxx ... end process xxx;"
function (fn)   bloc interactif "function xxx () return ;"
function (fnb)  idem (body)
procedure (pd)  bloc interactif "procedure xxx () ;"
procedure (pdb) idem (body)

for            bloc "for xxx in xxx loop ... end loop;"
it             bloc "if ... then ... end if;"
ite            bloc "if ... then ... else ... end if;"
ei             "elsif () then"
case           bloc "case ... end case;"

begin          bloc begin...end;
record         bloc record...end record;

cst            "constant ;"
type           "type ;"
var            "variable ;"

bb             "begin "
ee             "end "
dt             "downto "
sl             "std_logic" 
slv            "std_logic_vector()"
su             "std_ulogic" 
suv            "std_ulogic_vector()"
bv             "bit_vector()"
tslv           to_stdlogicvector()
tsuv           to_stdulogicvector()

r              interactif "xxx'event and xxx = '1'"
f              interactif "xxx'event and xxx = '0'"
wr             interactif "wait until xxx'event and xxx = '1';\n"
wf             interactif "wait until xxx'event and xxx = '0';\n"

}

###########################################################################
###########################################################################
###########################################################################
# CES PROCEDURES SERONT A RANGER AILLEURS POUR ETRE UTILISEES DANS 
# D'AUTRES MODES (LES GENERALISER EVENTUELLEMENT) :
###########################################################################

# ###########################################################################
# # proc start_of_line {textwidget}
# # return 1 si le cursor est en debut de ligne
# ###########################################################################
# proc start_of_line {{t .main.t}} {
#    set ind [.main.t index insert]
#    if [string match "*.0" $ind] then {
#       return 1
#    } else {
#       return 0
#    }
# }

###########################################################################
# proc separator {{NbLines 1}}
# Insère "Nblines" lignes (défaut : 1) correspondant au separateur 
# souhaité ;
# Cette procédure est automatiquement liée à <Meta-1>
###########################################################################
proc separator {{NbLines 1} } {
   
   insert_fill_lines "-" $NbLines 

} ;# endproc separator

######################################################################
# te:cmd:compile - compile file
######################################################################
proc te:cmd:compile {} {
  upvar #0 EDITPREFS(mode,ada,compilfile) compilfile
  append compilfile {}
  if {("x$compilfile" == "x") || [xtext_isDirty .main.t]} {
    stead:log  -title "Compile" "please save file first"
  } else {
    set old_dir [pwd]
    cd [file dirname $compilfile]
    
    if [catch { exec cv -message  -file $compilfile \
              -output  $compilfile.cv.out} msg]  then {
       stead:log -title "Erreur à la compilation" "$msg"
    } else {
       # on devrait y mettre le catch qui suit, mais leafrog
       # semble toujours se terminer avec erreur...
       
    } ;# endif
    catch {
      set f [open $compilfile.cv.out r]
      set result [read $f]
      close $f          
      stead:log -title "Compile [file tail $compilfile]"  "$result"
    }
     
    cd $old_dir
  }
}
######################################################################
# te:cmd:edit_compil_logfile - pour editer le fichier log
######################################################################
proc te:cmd:edit_compil_logfile {} {
   global stead
   upvar #0 EDITPREFS(mode,ada,compilfile) compilfile
   append compilfile {}
   if {("x$compilfile" == "x") || [xtext_isDirty .main.t]} {
      stead:log -title "Compile" "please save file first" 
   } else {
      set logfile $compilfile.cv.out
      if {[file exist $compilfile.cv.out]} {
         exec $stead(exe) $compilfile.cv.out &
      } else {
         stead:log -title "Edit Logfile $compilfile.cv.out" \
                  "fichier $compilfile.cv.out inexistant"
      }
   }
}

###########################################################################
###########################################################################

###########################################################################
# Alias pour le mode ada

electricAlias-def ${M}ada ${M}ada ${M}ada

electricAlias-def ada bb "begin"   ;# begin bloc
electricAlias-def ada ee "end"     ;# end bloc

###########################################################################
set a    "${B}askalias {package name} NAME${E}package $V{NAME} is\n\n"
append a "${B}i${E}$M\n\n"
append a "end $V{NAME} ;\n\n"
electricAlias-def ${M}ada pk  $a

set a    "${B}askalias {package name} NAME${E}package body $V{NAME} is\n\n"
append a "${B}i${E}$M\n\n"
append a "end $V{NAME} ;\n\n$M"
electricAlias-def ${M}ada pkb  $a

set a    "${B}askalias {entity name} NAME${E}entity $V{NAME} is\n"
append a  "${B}i${E}generic ( $M );\n"
append a  "${B}i${E}port ( $M );\n"
append a "end $V{NAME} ;\n$M"
electricAlias-def ${M}ada ent  $a

electricAlias-def ${M}ada -    "${B}separator 1${E}"
electricAlias-def ${M}ada --   "${B}separator 2${E}"
electricAlias-def ${M}ada ---  "${B}separator 3${E}"

set a    "${B}askalias {architecture name} NAME${E}architecture $V{NAME} "
append a "of $M is\n"
append a "${B}i${E}$M\n"
append a "begin\n\n${B}i${E}$M\n\n"
append a "end $V{NAME} ;\n$M"
electricAlias-def ${M}ada arch  $a

set a    "${B}askalias {function name} NAME${E}function $V{NAME} "
append a "( $M )\n         return $M;\n\n$M"
electricAlias-def ${M}ada fn  $a

set a    "${B}askalias {function name} NAME${E}function $V{NAME} "
append a "( $M )\n         return $M is\n\n"
append a "${B}i${E}$M\n"
append a "${M}begin\n${B}i${E}$M\nend $V{NAME}\n\n$M"
electricAlias-def ${M}ada fnb  $a

set a    "${B}askalias {procedure name} NAME${E}procedure $V{NAME}($M);\n$M"
electricAlias-def ${M}ada pd    $a

set a    "${B}askalias {procedure name} NAME${E}procedure $V{NAME}($M) is\n"
append a "${M}begin\n${B}i${E}$M\nend ;-- procedure $V{NAME} ;\n\n$M"
electricAlias-def ${M}ada pdb   $a

set a    "${B}askalias {process name} NAME${E}$V{NAME} : process $M\n"
append a "begin\n${B}i${E}$M\nend process $V{NAME} ;\n\n$M"
electricAlias-def ${M}ada process $a
electricAlias-def ${M}ada ps      $a

set a    "${B}askalias {bloc name} NAME${E}$V{NAME} : bloc\n"
append a "begin\n${B}i${E}$M\nend bloc $V{NAME} ;\n\n$M"
electricAlias-def ${M}ada bloc $a

set a    "for $M in $M loop\n"
append a "${B}i${E}$M\nend loop ;\n$M"
electricAlias-def ${M}ada for $a

set a    "if ($M) then\n${B}i${E}$M ;$M\n"
append a "end if ;\n$M"
electricAlias-def ${M}ada it $a
electricAlias-def ${M}ada if $a

set a    "if ($M) then\n${B}i${E}$M ;$M\n"
append a "else\n${B}i${E}$M ;$M\n"
append a "end if ;\n$M"
electricAlias-def ${M}ada ite $a

set a    "${B}te:cmd:indent_left${E}elsif ($M) then\n${B}i${E}$M"
# set a    "elsif ($M) then\n${B}i${E}$M"
electricAlias-def ada ei $a

set a    "case ($M) is\n${B}i${E}$M"
append a "\nend case ;\n$M"
electricAlias-def ${M}ada case $a

###########################################################################
# clock'event and clock = '1'
set a1 "${B}askalias {clock name} NAME${E}$V{NAME}'event and $V{NAME} = '1'"
electricAlias-def ${M}ada r  $a1

# clock'event and clock = '0'
set a0 "${B}askalias {clock name} NAME${E}$V{NAME}'event and $V{NAME} = '0'"
electricAlias-def ${M}ada f  $a0

# wait until clock'event and clock = '0';\n
electricAlias-def ${M}ada wf  "wait until $a0;\n$M"

# wait until clock'event and clock = '1';\n
electricAlias-def ${M}ada wr  "wait until $a1;\n$M"

###########################################################################
electricAlias-def ada sl    "std_logic"
electricAlias-def ada slv   "std_logic_vector($M)"
electricAlias-def ada su    "std_ulogic"
electricAlias-def ada suv   "std_ulogic_vector($M)"
electricAlias-def ada bv    "bit_vector($M)"
electricAlias-def ada tslv  "To_StdLogicVector($M)"

electricAlias-def ${M}ada lib  "library "

set a1     "library IEEE;\n"
set a2     "use IEEE.std_logic_1164.all;\n"
set a3     "use IEEE.std_logic_arith.all;\n"
set a4     "use std.textio.all;\n"
electricAlias-def ${M}ada ieee    "$a1$a2$a3$a4"

electricAlias-def ada cst    "constant $M : $M"
electricAlias-def ada type   "type $M;$M"
electricAlias-def ada var    "variable $M;$M"
electricAlias-def ${M}ada record "record\n${B}i${E}$M\nend;\n$M"
electricAlias-def ${M}ada begin  "begin\n${B}i${E}$M\nend;\n$M"

electricAlias-def ada dt "downto $M"

electricAlias-def ${M}ada wh "when $M => $M ;\n$M"


###########################################################################
# tri des procedures pour la navigation
# par ordre alphabetique
###########################################################################

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


######################################################################
# define the ada menu:
###########################################################################

te:mode:make_menu $MODE

.menu.$MODE.m add command -label {Edit Unix Command...} \
    -accelerator {<Meta-U>} -command {stead:editUnixResult}
.menu.$MODE.m add command -label {Compile file} \
   -command {te:cmd:compile}
.menu.$MODE.m add command -label {Edit Logfile file} \
   -command {te:cmd:edit_compil_logfile}
.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 $ada_HELP }  
.menu.$MODE.m add cascade -label {Files sample}  \
   -menu ".menu.$MODE.m.files"
   
menu .menu.$MODE.m.files
foreach {file} $MODE_FAST_EDIT {
   .menu.$MODE.m.files add command -label $file \
      -command "exec $stead(exe) $file &"
} ;# endforeach


###########################################################################
# On crée le menu template s'il n'existe pas
###########################################################################
te:mode:make_menu templates


###########################################################################
# Remplissage de menu template
###########################################################################

.menu.templates.m add command -label "Insérer un separateur" \
                      -command {separator 1}
.menu.templates.m add command -label "separateur" \
                      -command {insert_fill_lines "-" 72 1}
.menu.templates.m add command -label {standard libraries} \
                                -command {electricAlias-wrap ieee}

.menu.templates.m add separator
.menu.templates.m add command -label {package} \
                                -command {electricAlias-wrap pk}
.menu.templates.m add command -label {package (body)} \
                                -command {electricAlias-wrap pkb}
.menu.templates.m add command -label {entity} \
                                -command {electricAlias-wrap ent}
.menu.templates.m add command -label {architecture} \
                                -command {electricAlias-wrap arch}
                                
.menu.templates.m add separator
.menu.templates.m add command -label {bloc} \
                                -command {electricAlias-wrap bloc}
.menu.templates.m add command -label {process} \
                                -command {electricAlias-wrap process}
.menu.templates.m add command -label {function (declaration)} \
                                -command {electricAlias-wrap fn}
.menu.templates.m add command -label {function (body)} \
                                -command {electricAlias-wrap fnb}
.menu.templates.m add command -label {procedure (declaration)} \
                                -command {electricAlias-wrap pd}
.menu.templates.m add command -label {procedure (body)} \
                                -command {electricAlias-wrap pdb}
                                
.menu.templates.m add separator
.menu.templates.m add command -label {for} \
                                -command {electricAlias-wrap for}
.menu.templates.m add command -label {if ... then} \
                                -command {electricAlias-wrap it}
.menu.templates.m add command -label {if ... then ... else} \
                                -command {electricAlias-wrap ite}
.menu.templates.m add command -label {elsif ... then} \
                                -command {electricAlias-wrap ei}
.menu.templates.m add command -label {case} \
                                -command {electricAlias-wrap case}
                                
.menu.templates.m add separator
.menu.templates.m add command -label {rising(XXX)} \
                                -command {electricAlias-wrap r}
.menu.templates.m add command -label {wait until rising(XXX)} \
                                -command {electricAlias-wrap wr}
.menu.templates.m add command -label {falling(XXX)} \
                                -command {electricAlias-wrap f}
.menu.templates.m add command -label {wait until falling(XXX)} \
                                -command {electricAlias-wrap wf}


.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 "te:cmd:expand_alias [te:no_interp $alias]"
}
###########################################################################

######################################################################
# cleanup for ada mode
######################################################################

proc stead:modeCleanup {} "
  global MODE
  te:mode:destroy_menu $MODE
  te:mode:destroy_menu templates
  te:cmd:destroy_alias_menu .menu.templates.m
"

