# tcl-mode.tcl - mode for editing tcl code
# Modifié par Maurice DIAMANTINI (diam@ensta.fr)
# 
# diam (05/12/96) : modif (légères) des procédures de coloriage
# 10/07/96 : rajout colorisation de "return" en rouge (comme global, upvar..)
# 27/06/95 : coloris. de global (bug) + uplevel et upvar
# 30/05/95 : 
# 13/09/96-17/09/96 : Modification du principe de coloriage. (Modifs 
#                     par David Carqueij (carqueij@ensta.fr))
######################################################################
global MODE EDITPREFS

########################################################################
# cette variable contient une liste de fichier à éditer dans ce mode
global MODE_FAST_EDIT
set MODE_FAST_EDIT {
    /insert/here/you/favorite/list/of
    /files/modeles
    see_file_make-mode.tcl_in_stead_library
}

######################################################################
# define new prefix for tcl mode
set EDITPREFS(autobreak) {0}
set EDITPREFS(prefix) "# "

########################################################################
# chaine de recherche (utilisé pour le générer le menu de navigation) :
global TE_MODE_SEARCH_STRING TE_MODE_NAVIG_SHOW_TEXT  
# modif diam 30/08/00 
# set TE_MODE_SEARCH_STRING "\n\[ \t\]*proc\[ \t\]*(\[^ \t\n\{\]+)"
set TE_MODE_SEARCH_STRING {\n[ \t]*proc[ \t]*([^ \t\n\{]+)}
set TE_MODE_NAVIG_SHOW_TEXT "procs" ;# nom de menu de navigation


########################################################################
# DEBUT de gestion des couleurs
########################################################################

########################################################################
# creePatternMotsClefs
# Cette procedure renvoie une expression reguliere permettant de reperer
# aisement des mots clefs
# - beforeMotsClefs : patterne précédent tout mot cléé
# - beforeMotsClefs : patterne suivant tout mot cléé
# - listeMotsClefs : liste de patternes définissant les mot clés.
# exemple :... (a faire)
proc creePatternMotsClefs {beforeMotsClefs AfterMotsClefs listeMotsClefs} {
    return "${beforeMotsClefs}([join $listeMotsClefs |])$AfterMotsClefs"
}

########################################################################
# On definit une variable MODECOLOR qui contiendra une association entre 
# un pattern, son type (simple pour un pattern reconnaissable sur une 
# ligne, complexe pour un pattern reconnaissable sur plusieurs lignes), 
# son nom symbolique, et enfin sa couleur.

global MODECOLOR

# set BindingsRegExp {"<\[^>\]*>"}
set BindingsRegExp {<[^>]*>}

# set beforeMotClef {"( |\t|^|\{|\\\[)}
# set afterMotClef {( |\t|$|\})"}
set beforeMotClef "(^| |\t|^|\{|\\\[)"
set afterMotClef  "( |\t|\}|\$)"

# la procedure "creePatternMotsClefs" renvoie un pattern contenant l'expression
# reguliere permettant de reconnaitre un mot clef. Pour TCL, un mot clef 
# commence par soit un debut de ligne, un espace, un tab, un [ ou un {. Il
# finit par une fin de ligne (Ex : "return\n"), un espace ou un tab.
# Remarque : pour mettre à la fois "package require" et package, il faut
# metre le mot simple en dernier !
# 
set scopesRegExp [creePatternMotsClefs $beforeMotClef $afterMotClef { 
   global upvar continue uplevel break default error send source 
   update exit return variable vwait after
   "namespace eval" "namespace export" namespace
   "package require" "package provide" package
}]

set afterMotClef "( |\t|\$)"
set motClefRegExp [creePatternMotsClefs $beforeMotClef $afterMotClef { 
   set unset foreach 
   list lappend concat lindex linsert llength lsearch lreplace
   switch if puts while expr 
   close open else elseif subst incr regexp 
   eval glob pwd cd 
   eof flush gets read seek tell fconfigure fileevent socket
   catch for 
   scan append  "array exists" "array get" "array names" "array set" 
   "array size" "array startsearch" "array nextelement" 
   "array anymore" "array donesearch" 
   info "info proc" "info body" "info command" "info args" "info complete"
   "info exists" "info global" "info library" 
   "trace variable" "trace vdelete" 
   "trace vinfo" "string match" "string compare" "string index" 
   "string last" "string range" "string length" "string tolower" 
   "string toupper" "string trim" "string trimleft" "string trimright" 
   "string wordend" "string worstart" 
   "string equal"  
   regsub regexp
   "file atime" "file dirname" 
   "file executable" "file exists" "file extension" "file isdirectory" 
   "file isfile" "file lstat" "file mtime" "file owned" "file readable" 
   "file readlink" "file rootname" "file size" "file stat" "file tail" 
   "file type" "file writable" 
   "interp create" "interp alias" 
   bind pack frame radiobutton entry label 
   checkbutton frame button unset "wm title" wm
}]

# set commentRegExp   "(^|;)\[ \t\]*#\[^\n]*$"
# set procRegExp      "(^| |\t)proc\[ \t\]+(\[^ \t\{\]+)"
# set guillemetRegExp "\"\[^\"\]*\""

# Rajout des commentaires du type "switch ... { # ... }"
set commentRegExp   "(^|;|\{)\[ \t\]*#\[^\n]*$"
set procRegExp      "(^| |\t)proc\[ \t\]+(\[^ \t\{\]+)"
set guillemetRegExp "\"\[^\"\]*\""

# Pour finir, on cree une liste de liste contenant le type, le nom, le pattern,
# et le code TCL permettant de colorier...

set MODECOLOR($MODE,colorList) [list \
    [list simple procedure  $procRegExp      {-foreground red}]  \
    [list simple motClef    $motClefRegExp   {-foreground blue}] \
    [list simple scopes     $scopesRegExp    {-foreground red}]  \
    [list simple bindings   $BindingsRegExp  {-foreground red4}] \
    [list complexe guillemetComplexe      Ceci est un Test ... ] \
    [list simple guillemet  $guillemetRegExp {-foreground #700}] \
    [list simple comment    $commentRegExp   {-foreground #060}] \
]

unset BindingsRegExp beforeMotClef afterMotClef scopesRegExp motClefRegExp \
  commentRegExp procRegExp guillemetRegExp 
########################################################################
# Cette procédure recolorise l'ensemble du fichier
proc refresh_colors {} {
   
   global MODECOLOR MODE
   # On commence par effacer les couleur existantes
   cancel_colors
   # on colorise l'ecran...
   te:cmd:coloriseStruct .main.t $MODECOLOR($MODE,colorList) screen
   # On colorise tout le fichier...
   te:cmd:coloriseStruct .main.t $MODECOLOR($MODE,colorList) all
   
}

# # # # On définit un raccourci clavier
# # # bind .main.t <Control-c> refresh_colors

########################################################################
# Cette procédure supprime les couleurs
proc cancel_colors {} {
   global MODECOLOR MODE
   foreach pat $MODECOLOR($MODE,colorList) {
      te:colours:clear_foregroundStruct .main.t all [lindex $pat 1]
   }
}

########################################################################
# la procedure suivante permet de colorier la ligne courante a chaque
# appuie sur return.
########################################################################
proc stead:returnkey_post_hook {{text .main.t}} {
    global MODECOLOR MODE
    te:cmd:coloriseStruct $text $MODECOLOR($MODE,colorList) previousLine
     
}
########################################################################
# la procedure suivante permet de colorier la ligne courante a chaque
# appuie sur espace.
########################################################################
proc stead:spacebar_post_hook {{text .main.t}} {
    global MODECOLOR MODE
    te:cmd:coloriseStruct $text $MODECOLOR($MODE,colorList) currentLine 
}
########################################################################

##############################################################################
#  what is executed after the file is read (colorization)
##############################################################################
proc stead:read_post_hook {filename text} {
   .main.t see 1.0
   refresh_colors
}
########################################################################
# FIN de gestion des couleurs
########################################################################



###########################################################################
# aide sur le mode TCL :
###########################################################################
global ${MODE}_HELP
set ${MODE}_HELP {
aide du mode TCL 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 "###..."

for            boucle for
foreach        boucle foreach
while          boucle while
if             if

proc           bloc interactif procedure
}

########################################################################
# pour simplifier l'ecriture des electric-alias en déclarant :
#    M : Marque temporaire
#    B : début de postcommande 
#    E : fin de postcommande
#    V : Inclusion d'une variable TCL
electricAlias-use8bitsCars

# diam 23/08/00 vommenté (inutile ?)
# # # Aliases for tcl mode
# # electricAlias-def ${M}tcl ${M}tcl ${M}tcl
# # 
# # electricAlias-var tcl bb "\{"
# # electricAlias-var tcl eb "\}"
# # electricAlias-var tcl bc "# "
# # electricAlias-var tcl ec ""
# # set    t1 "########################################"
# # append t1 "########################################\n"
# # electricAlias-var tcl sep $t1
# # electricAlias-def tcl $V "$V\{$M\}"

## diam 21/08/00 essai d'un nouvelle API pour les electricAlias
#  On n'utilise plus que les caractere spéciaux TCL [ ] et $
# 

set    tmp {[askVar "procedure name" NAME]}
append tmp {## [getVar NAME] -- [setStop]\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]}
electricAlias-def ${M}tcl proc $tmp

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]}
electricAlias-def ${M}tcl proc2 $tmp

set    tmp "${B}askalias {procedure name} NAME${E}"
append tmp "## $V{NAME} -- $M\n"
append tmp "# \n"
append tmp "# \n"
append tmp "# \n"
append tmp "proc $V{NAME} \{$M\} \{\n"
append tmp "${B}i${E}$M\n"
append tmp "\}\n"
append tmp "$M"
electricAlias-def ${M}tcl procold $tmp


electricAlias-def ${M}tcl tclsh   "${B}insert_tclsh_header insert${E}"
electricAlias-def ${M}tcl wish    "${B}insert_wish_header  insert${E}"

## alias switch multiplateform
# global tcl_platform
# 
# switch -- $tcl_platform(platform) {
#     macintosh {
#        CODE pour Mac
#     }
#     windows -
#     default {
#         CODE pour windows et unix
#     }
# }
# 
set    tmp {global tcl_platform\n}
append tmp {switch -exact -- \$tcl_platform(platform) \{\n}
append tmp {  macintosh \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {  windows \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {  unix \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {\}\n}
append tmp {[setStop]\n}
# 
electricAlias-def ${M}tcl plat $tmp


# foreach sans ";# endforeach"
set t1 {foreach [setStop]  [setStop]  \{\n[i][setStop]\n}
set t2 {\}\n[setStop]}
electricAlias-def ${M}tcl foreach $t1$t2
electricAlias-def ${M}tcl fe      $t1$t2

# foreach avec ";# endforeach"
set t1 {foreach [setStop]  [setStop]  \{\n[i][setStop]\n}
set t2 {\} ;# endforeach\n[setStop]}
electricAlias-def ${M}tcl Foreach $t1$t2
electricAlias-def ${M}tcl Fe      $t1$t2

# for sans "endfor"
set    tmp {for \{[setStop]\} \{[setStop]\} \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl for $tmp

# for avec "endfor"
set    tmp {for \{[setStop]\} \{[setStop]\} \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}  ;# endfor\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl For $tmp

# for sans "endwhile"
set    tmp {while \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl while $tmp
electricAlias-def ${M}tcl w     $tmp

# for avec "endwhile"
set    tmp {while \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}  ;# endwhile\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl While $tmp
electricAlias-def ${M}tcl W     $tmp

# if sans "endif"
set    tmp {if \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl if $tmp

# if avec "endif"
set    tmp {if \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\}  ;# endif\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl If $tmp

# if/else sans "endif"
set    tmp {if \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\} else \{\n}
append tmp {[i][setStop]\n}
append tmp {\}\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl ife $tmp

# if/else avec "endif"
set    tmp {if \{[setStop]\} \{\n} 
append tmp {[i][setStop]\n}
append tmp {\} else \{\n}
append tmp {[i][setStop]\n}
append tmp {\}  ;# endif\n}
append tmp {[setStop]}
electricAlias-def ${M}tcl Ife $tmp


set    tmp {switch -exact -- [setStop] \{\n}
append tmp {  [setStop] \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {  [setStop] \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {  default \{\n}
append tmp {  [i][setStop]\n}
append tmp {  \}\n}
append tmp {\}\n}
append tmp {[setStop]\n}
# 
electricAlias-def ${M}tcl switch $tmp
electricAlias-def ${M}tcl sw     $tmp


# electricAlias-def ${M}tcl switch  "switch \{$M\} \{\n  $M\n\} ;# endswitch\n$M"


electricAlias-def tcl "=" "=="
electricAlias-def tcl backwordWord backwardWord


electricAlias-def ${M}tcl "${M}file" {# FILE: $stead(filename)
# 
# LAST UPDATE:  [now] 
# \
}
electricAlias-def ${M} "${M}procs" {# This file contains the following tcl procedure(s):
#
#	¤Çaskalias "tcl Proc" procÈ¤{proc} -- 
}

# insert les en-tete de script pour wish ou tcl (NE MARCHE PAS BIEN :
# UTILISER PLUTOT LES MENUS)
proc insert_wish_header { {idx 1.0} } {
    set    txt "#!/bin/sh\n"
    append txt "# the next line restarts using wish \\\n"
    append txt {exec wish "$0" -- ${1+"$@"}}
    append txt \n
    insert $txt $idx
}

proc insert_tclsh_header { {idx 1.0} } {
    set    txt "#!/bin/sh\n"
    append txt "# the next line restarts using tclsh \\\n"
    append txt {exec tclsh "$0"    ${1+"$@"}}
    append txt \n
    insert $txt $idx
}

proc insert_switch_platform_header { {idx insert} } {
    set    txt "global tcl_platform\n"
    append txt "[i]switch -exact -- \$tcl_platform(platform) \{\n"
    append txt "[i]  macintosh \{\n"
    append txt "[i]  \} \n"
    append txt "[i]  windows \{\n"
    append txt "[i]  \} \n"
    append txt "[i]  unix \{\n"
    append txt "[i]  \} \n"
    append txt "[i]\} \n"
    append txt \n
    insert $txt $idx
} ;#endproc insert_switch_platteform_header

proc insert_library { {lib  "~/lib/tcl"} } {
    # on veut générer une ligne de la forme :
    # set auto_path [concat [list [glob ~/lib/tk]] $auto_path]
    set    txt {set auto_path [concat [list [ glob }
    append txt "$lib"
    append txt { ] ] $auto_path ]}
    append txt "\n"
    insert $txt 
} ;#endproc insert_library


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


# proc te:mode:navig_label_hook {t} {
#   global TE_MODE_SEARCH_STRING
# 
#   regexp $TE_MODE_SEARCH_STRING $t intitule nom
#   return $nom
# }
  
proc te:mode:navig_sort_hook {l} {
  return [lsort -command te:mode:sort_command $l]
}
 

######################################################################
# define the TCL menu:

te:mode:make_menu $MODE

.menu.$MODE.m add command -label {search selected proc} \
   -command {stead:searchTclProc $stead(text)}
.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 [set ${MODE}_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 "stead $file"
} ;# endforeach



# ###########################################################################
# # definit le menu des mots-cles
# 
# te:mode:make_menu {templates}
# 
# te:cmd:create_alias_menu .menu.templates.m


###########################################################################
# 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 {proc...} \
                              -command {electricAlias-wrap proc}

.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 {if} \
                              -command {electricAlias-wrap if}

.menu.templates.m add separator
.menu.templates.m add command -label {Switch multiplatform (pour tk4.2)} \
                              -command {insert_switch_platform_header}
.menu.templates.m add separator
.menu.templates.m add command -label {En-tête "#!..wish"} \
                              -command {insert_wish_header 1.0}
.menu.templates.m add command -label {En-tête "#!..tclsh"} \
                              -command {insert_tclsh_header 1.0}
.menu.templates.m add command -label {Add library  ~/lib/tcl"} \
                              -command {insert_library ~/lib/tcl}
.menu.templates.m add command -label {Add library  ~/lib/tk"} \
                              -command {insert_library ~/lib/tk}

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

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

}













