#f balance.tcl - gestion des parenthèse et de la balance
# (recherche du "partenaire gauche" et selection )
# 
# 
# IDEES :
# - créer deux proc de base 
#      xtext_findLeftPartner {w parSpec startIdx}
#      xtext_findRightPartner {w parSpec startIdx}
#   Qui recherche le partenaire balancé d'une parenthèse spécifiée par 
#   un "parSpec" (spécification de parenthèse)
# 
# - remplacer toute proc xtext_getXXXIndex par xtext_findXXX
# 
# Historique :
#   04/07/02 (md) : modif pour accepter une chaine comme parenthèse
#   
package provide xtext 2.0

########################################################################
# Info sur un exemple d'utilisation (potentiellement périmé)
# 
# fichier xtext_procs.tcl , proc xtext_insert :
# 
#     if {$opt(-balance)} {
#         foreach triplet $xtext(balance_list) {
#             foreach {rightSym leftChar rightChar} $triplet {break}
#             if {[string length $rightChar] > 1} {
#                 continue
#             }
#             
#             if {[string equal "$buf_data" "$rightChar"]} {
#                 xtext_highlightOpenPartner \
#                         $w $leftChar $rightChar "[$w index insert] -1c"
#             }
#             # On ne cherche pas de parenthese fermante en fin de fichier
#             # Car on ne l'a probablement pas encore saisie !
#             
#             if {[string equal "$buf_data" "$leftChar"] \
#                     && [$w compare insert < end-2c]} {
#                 xtext_highlightClosePartner \
#                         $w $leftChar $rightChar "[$w index insert] -1c"
#             }
#         }
#     }
#     
# Fichier xtext.tcl : 
#     bind XText <$stead(Meta)-b>    {xtext_selectBalance %W}


## xtext_highlightOpenPartner (anciennement search_left_partner)
##           search for left partner of character $left in text $w
#
proc xtext_highlightOpenPartner {w openChar closeChar closeIdx} {

    set searchMsg "searching for \"$openChar\" ..."
    stead:log $searchMsg
    set result [xtext_getOpenPartnerIndex $w $openChar $closeChar $closeIdx]
    if {($result == "")} {
        stead:log -error "$searchMsg NOT FOUND!"
    } else {
        stead:log  "$searchMsg found  at $result!"
        xtext_applyShortHighlight $w $result "$closeIdx + 1c"
    }
}


## xtext_highlightClosePartner 
##           search for close partner of character $close in text $w
#
proc xtext_highlightClosePartner {w openChar closeChar openIdx} {

    # # # error "xtext_getClosePartnerIndex NON IMPLEMENTEE (BLOQUE TOUT !!)"
    set searchMsg "searching for \"$closeChar\" ..."
    stead:log $searchMsg
    set result [xtext_getClosePartnerIndex $w $openChar $closeChar $openIdx]
    if {($result == "")} {
         stead:log -error "$searchMsg NOT FOUND!"
    } else {
        stead:log  "$searchMsg found at $result!"
        xtext_applyShortHighlight $w "$openIdx"  "$result + 1c"
    }
}

## xtext_getOpenPartnerIndex - retoune l'index de l'ouvrant balancé
#
# On cherche en amont l'ouvrant "openChar" associé au fermant  "closeChar"
# à partir de l'index spécifié par "closeIdx"
#
proc xtext_getOpenPartnerIndex {w openChar closeChar closeIdx} {


    # on cherche le premier ouvrant situé en amont du fermant
    set openIdx [$w search -nocase -backwards $openChar $closeIdx 1.0]

    # tant qu'on trouve un ouvrant
    while {[string length $openIdx]} {
        # Cet ouvrant est le bon SSI il n'y a pas de fermant entre cet
        # ouvrant et le fermant trouvé précédement.
        set closeIdx [$w search -nocase -backward \
                            $closeChar  $closeIdx   $openIdx ]

        if {![string length $closeIdx]} {
            # Plus de parenthèse fermante imbriquée :
            # on a donc trouvé la bonne parenthèse ouvrante
            return $openIdx
        }
        # Cette parenthèse gauche n'est pas la bonne.
        # On doit continuer à chercher vers le début du texte, à
        # partir de cette mauvaise parenthèse droite $closeIdx.
        # on cherche l'ouvrant situé juste avant l'ouvrant précédent
        set openIdx [$w search -nocase -backwards $openChar $openIdx 1.0]

    }
    return ""
}

## xtext_getClosePartnerIndex - cherche le partenaire fermant d'une
#           parenthèse ouvrante
# 
# Prévoir option -exact, -regexp; -glob pour la recherche de chaine
#
# proc xtext_getClosePartnerIndex {w openChar closeChar openIdx} {
#     
#     set openLength  [string length $openChar]
#     set closeLength [string length $closeChar]
#     
#     # on cherche le premier fermant situé en aval de l'ouvrant
#     set closeIdx [$w search -nocase -forwards $closeChar \
#             "$openIdx + $openLength c" end]
#     # tant qu'on trouve un fermant
#     while {[string length $closeIdx]} {
#         # Ce fermant est le bon SSI il n'y a pas d'ouvrant entre ce
#         # fermant et l'ouvrant trouvé précédement.
#         set openIdx [$w search -nocase -forwards $openChar  \
#                 "$openIdx + $openLength c"   $closeIdx ]
# 
#         if {![string length $openIdx]} {
#             # Plus de parenthèse ouvrante imbriquée :
#             # on a donc trouvé la bonne parenthèse fermante
#             return $closeIdx
#         }
#         # Cette parenthèse droite n'est pas la bonne.
#         # On doit continuer à chercher vers la fin du texte, à
#         # partir de cette mauvaise parenthèse gauche $openIdx.
#         # on cherche le fermant situé juste avant le fermant précédent
#         set closeIdx [$w search -nocase -forwards $closeChar \
#                     "$closeIdx + $closeLength c" end]
# 
#     }
#     return ""
# }
proc xtext_getClosePartnerIndex {w openChar closeChar openIdx} {
    
    set openLength  [string length $openChar]
    set closeLength [string length $closeChar]
    
    # on cherche le premier fermant situé en aval de l'ouvrant
    set closeIdx [$w search -nocase -forwards $closeChar \
            "$openIdx + 1 c" end]
    # tant qu'on trouve un fermant
    while {[string length $closeIdx]} {
        # Ce fermant est le bon SSI il n'y a pas d'ouvrant entre ce
        # fermant et l'ouvrant trouvé précédement.
        set openIdx [$w search -nocase -forwards $openChar  \
                "$openIdx + 1 c"   $closeIdx ]

        if {![string length $openIdx]} {
            # Plus de parenthèse ouvrante imbriquée :
            # on a donc trouvé la bonne parenthèse fermante
            return $closeIdx
        }
        # Cette parenthèse droite n'est pas la bonne.
        # On doit continuer à chercher vers la fin du texte, à
        # partir de cette mauvaise parenthèse gauche $openIdx.
        # on cherche le fermant situé juste avant le fermant précédent
        set closeIdx [$w search -nocase -forwards $closeChar \
                    "$closeIdx + 1 c" end]

    }
    return ""
}

## xtext_selectBalance - selectionne la partie de texte entouree de deux
##                  elements de balance
#
#
proc xtext_selectBalance {w} {
    global xtext

    stead:log "working ..."

    # S'il y a une selection, elle doit ere entierement contenue dans la
    # zone à reselectionner.
    #
    if {[xtext_hasSel $w]} {
        # les limites internes de la zone (balancée) à sélectionner
        set leftLimit  [$w index sel.first]
        set rightLimit [$w index sel.last-1c]
    } else {
        set leftLimit  [$w index insert]
        set rightLimit [$w index insert-1c]
    }
    set bad 0


    # On recherche les premieres parenthèses fermante à gauche
    # de la sélection, et ouvrante à droite de la sélection. 
    set left_index_parSpec  [xtext_getNextLeftUnBalanced  $w $leftLimit]
    set right_index_parSpec [xtext_getNextRightUnBalanced $w $rightLimit]
    
    # on distribue les éléments correspondant à la détection de ces
    # parenthèses gauche et droite (rightSym n'est pas utilisé par la suite).
    # 
    set leftIndex [lindex $left_index_parSpec 0]
    set leftSpec  [lindex $left_index_parSpec 1]
    # set rightSym           [lindex $leftSpec 0]
    set leftOpenString      [lindex $leftSpec 1]
    set leftCloseString     [lindex $leftSpec 2]
                           
    set rightIndex [lindex $right_index_parSpec 0]
    set rightSpec  [lindex $right_index_parSpec 1]
    # set rightSym           [lindex $rightSpec 0]
    set rightOpenString      [lindex $rightSpec 1]
    set rightCloseString     [lindex $rightSpec 2]
                           
    # si aucune des deux : c'est bon car équilibré
    if {![string length "$left_index_parSpec"] \
                && ![string length "$right_index_parSpec"]} {
        stead:log -info "Plus de parenthèses englobantes."
        return
    }
    if {![string length "$left_index_parSpec"] \
                && [string length "$right_index_parSpec"]} {
        stead:log -error "Partenaire gauche de ($rightIndex) introuvable !"
        set leftIndex 1.0
        set bad 1
    } elseif {[string length "$left_index_parSpec"] \
                && ![string length "$right_index_parSpec"]} {
        stead:log -error "Partenaire droit de ($leftIndex) introuvable !"
        set rightIndex end
        set bad 1
    } else {
        # Il faut comparer les deux ouvrantes ou bien les deux fermantes !
        if {![string equal $leftOpenString $rightOpenString]} {
            stead:log -error "Partenaire gauche ($leftIndex) et\
                    droit ($rightIndex) incohérents !"
            set bad 1
        } else {
            stead:log -info "Extension balance correcte\
                ($leftIndex -- $rightIndex)."
        }
    }
    
    # On sélectionne le résultat englobant, avec du rouge en cas d'erreur.
    # 
    # L'index de droite doit également être surligné (ou sélectionné)
    # car nomalement la limite droite est excluse de "$w tag add..."
    # 
    # Modif diam le 03/07/02
    # set rightIndex [$w index $rightIndex+1c]
    set rightIndex [$w index $rightIndex+[string length $rightCloseString]c]
    if {$bad} {
        set errorFlashTime 2000
        $w tag add error $leftIndex $rightIndex
        xtext_applyShortHighlight $w          \
                -tags error                   \
                -flashtime $errorFlashTime    \
                $leftIndex $rightIndex
        
        xtext_select $w $leftIndex $rightIndex
    } else {
        xtext_select $w $leftIndex $rightIndex 
    }
        
}

## xtext_getNextRightUnBalanced --   *****  PRIVATE *****
##       détecte la premiere parenthèse fermante à droite d'un index
#
# Retourne la premiere parenthèse droite située à droite de l'index spécifié.
# Utilise la globale xtext(balance_list)
# retourne :
#   - une liste vide si rien trouvé
#   - une paire de la forme {index parSpec} dans laquelle
#         un parSpec est une spécication de parenthese définie par un
#         triplet de la forme { rightSym openChar closeChar }
#
proc xtext_getNextRightUnBalanced {w idx  } {
    global xtext

    set MAX_INDEX 999999999.0        ;# infini ~ MAX_INDEX
    set nextRightIndex $MAX_INDEX

    # on cherche le closeChar le plus proche à droite de l'index
    #
    foreach parSpec $xtext(balance_list) {
        foreach {rightSym openChar closeChar} $parSpec {break}

        set thisIndex [xtext_getClosePartnerIndex $w \
                                $openChar $closeChar $idx]
        if { ![string length $thisIndex] } {
            # closeChar introuvable à droite du point d'insertion
            continue
        }
        if {[$w compare $thisIndex < $nextRightIndex]} {
            set nextRightIndex $thisIndex
            set nextParSpec    $parSpec
        }
    }
    # si on n'a rien trouve, on arrete
    if {$nextRightIndex == $MAX_INDEX} {
        return [list]
    } else {
        return [list $nextRightIndex $nextParSpec]
    }
}

## xtext_getNextLeftUnBalanced --   *****  PRIVATE *****
##       détecte la premiere parenthèse fermante à droite d'un index
#
# Retourne la premiere parenthèse droite située à droite de l'index spécifié.
# Utilise la globale xtext(balance_list)
# retourne :
#   - une liste vide si rien trouvé
#   - une paire de la forme {index parSpec} dans laquelle
#         un parSpec est une spécication de parenthese définie par un
#         triplet de la forme { rightSym openChar closeChar }
#
proc xtext_getNextLeftUnBalanced {w idx  } {
    global xtext

    set MIN_INDEX 0.0
    set nextLeftIndex $MIN_INDEX

    # on cherche le openChar le plus proche à gauche de l'index
    #
    foreach parSpec $xtext(balance_list) {
        foreach {rightSym openChar closeChar} $parSpec {break}

        set thisIndex [xtext_getOpenPartnerIndex $w \
                                $openChar $closeChar $idx]
        if { ![string length $thisIndex] } {
            # openChar introuvable à gauche du point limite
            continue
        }
        if {[$w compare $thisIndex > $nextLeftIndex]} {
            set nextLeftIndex $thisIndex
            set nextParSpec    $parSpec
        }
    }
    # si on n'a rien trouve, on arrete
    if {$nextLeftIndex == $MIN_INDEX} {
        return [list]
    } else {
        return [list $nextLeftIndex $nextParSpec]
    }
}

# ./
