# xtext_proc.tcl --
# 
# 
# Voir info dans fichier xtext.tcl
# 
# 
package provide xtext 2.0

# Ce fichier est à réorganiser comme suit :
# 
#  1 - les deux commandes de base pour l'insertion/suppression ou la
#      suppression de texte. TOUTE modification du widget devra passer
#      par ces deux commandes
#  2 - selection/déselection (par clavier, souris ou autre)
#      et de manipulation des marques (insert, ...)
#  3 - les commandes de manipulation du presse-papier (cut/copy/paste)
#  4 - les commandes modification secondaires
#      DeleteLeft, DeleteLeftWord, KillLine, Transpose
#  5 - les commandes de recherche (find, findNextPara, findNextWord..)
#  6 - les commandes de déplacements secondaires 
#          NextPara, NextWord, upDaownLine
########################################################################

#f######################################################################
#f 1 - les deux commandes de base pour l'insertion/suppression ou la
#f     suppression de texte. TOUTE modification du widget devra passer
#f     par ces deux commandes
#f######################################################################


## xtext_insert -- procédure principale pour toutes insertion de texte
# 
# Cette procédure insère soit une chaine, soit un buffer (oldSel, clip, ...).
# Cette commande tient compte des fonctionnalités de undo, de multiévaluation
# de sélection rectangulaire, ... grace à de nombreuses options :
# Le texte à insérer peut être défini explicitement grace aux options
# -buffer ou -string, ou implicitement comme argument supplémentaire 
# (équivalent à utiliser l'option -string)
# 
# Syntaxe :
# 
#   xtext_insert $w ?keyValues? ?string?
# 
# Exemples :
#
#   xtext_insert $w "Bonjour tout le monde"
#   xtext_insert $w -- $anyString
#   xtext_insert $w -push 0 -string $str
#   xtext_insert $w -push 1 -buffer "clip"
#   xtext_insert $w -push 1 -- $str
#   xtext_insert $w -index 23.4 -force rect -tag sel  -- $string
# 
#   xtext_insert $w  -index "end-10l+3c"  -force rect -string  $str
# 
# option :
# 
#  -index <index> Choix du lieu d'insertion.
#      Le comportement de cette proc est différent si le lieu d'insertion
#      est la marque "insert" (car gestion de la sélection et du curseur)
#  -delsel 1|0 : si 1, mémorise puis supprime la sélection avant toute
#      insertion à l'insert (inactif pour d'autre index)
#  -remsel 1|0 : si 1, mémorise puis dessélectionne le texte sélectionné
#      avant toute insertion à l'insert (inactif pour tout autre index)
#  -buffer <bufferName> (oldSel | clip)
#     un buffer est un objet à inserer pouvant etre
#     rectangulaire ou non, presse-papier, sélection, avec
#     ou sans le formatage...
#  -rect <auto|0|1> (défaut auto)
#       si "1"
#           demande d'interpréter le texte comme un bloc rectangulaire
#           meme si le buffer est du texte non rectangulaire.
#           Au besoin, égalise les lignes du texte à insérer
#       si  "auto" : 
#           se débrouille tout seul en fonction de l'aspect disjoint
#           du texte à insérer (dans le cas d'un buffer ou de la sélection)
#  -plain  <auto|0|1> (défaut auto) (PROJET)
#       si "1"
#           Force l'interpétation de texte pur, meme si le buffer contenait
#           des informations de formatage.
#           Cette option sera implémentée si besoin quand les tags seront
#           intergrés au buffers
#           pour gérer un mode "wiziwig" en html...
#  -push <auto|0|1>  spécifie si on doit ou non effectuer un pushState
#      - si le texte n'était pas modifié (conforme au fichier) alors un 
#        pushState est **toujours** effectué
#      - si le texte était déja dans un état modifié, alors
#        -push auto (par défaut) 
#            un push n'est effectué que si le point
#            d'insertion a été déplacé depuis l'insertion précédante
#            ( par exemple suite à un appui sur <Button-1> )
#        -push 1   un push est effectué
#        -push 0   aucun push n'est effectué
#      
#  -n  <integer>  (0 pour auto) Nbre d'insertion à répéter
#  -tags { tag1 tag2 ...} les tags à affecter au texte inséré
#       (cette information pourra être intégré à l'objet "buffer")
#  -balance <bool> active la vérification dynamique des parenthèses
# 
# Nota sur la balance (highliting) : 
# 
#    La fonctionnalité de surlignement dynamique lors de la saisie de 
#    parenthèses fermantes devrait être réalisé par un binding comme
#    suit :
#          bind XText <$rightSym> \
#               [list  xtext_insertRightPartner %W $leftChar $leftChar ]
#    Seulement, ceci ne fonctionne que si le widget reçoit les symboles 
#    de nom "$rightSym" (en toute lettre), ce qui n'est pas le cas avec 
#    tous les serveur X !!
#    En effet, un  serveur peut tres bien retourner le bon caractère ascii
#    "rightChar" sans la bonne information "rightSym" !
#    Conclusion : 
#    J'intègre cette fonctionnalité dans cette procédure "xtext_insert"
#    avec un test sur chaque parenthèse droite insérée !
# 
# 
proc xtext_insert {w args} {
    global xtext

    Parsarg_fullSpec opt {
        p  -
        push  {
            -type     enum
            -values   {auto 0 1}
            -label   "si vrai : l'état du texte est sauvegardé (pour undo)"
        }
        rect  {
            -type     enum
            -values   {auto 0 1}
            -label   "si vrai : force l'interprétation rectangulaire."
        }
        balance {
            -type boolean
            -default 0
            -label "si vrai : vérif des parenthèses et surlignement"
        }
        
        style {
            -type boolean
            -default 1
            -label "si vrai : effectue la colorisation dynamique"
        }
        
        ds  -
        delsel {
            -default  1
            -type     boolean
            -label   "si vrai : la sélection est mémorisée, puis supprimée"
        }
        
        rs  -
        remsel  {
            -default  0
            -type     boolean
            -label   "si vrai : la sélection est dessélectionnée"
        }
        
        i  -
        index {
            -default insert
            -label "index d'insertion du texte"
        }
        
        n {
            -type    integer
            -default 0
            -label "nombre d'insertions à répéter"
        }
        
        b -
        buffer      ""
        
        s -
        string      ""
        
        t -
        tags        {}
        
    }
    
    # Que faut-il insérer ?
    if {[string length $opt(-buffer)]} {
        if {[lsearch $xtext(buffers) $opt(-buffer)] == -1} {
            error "\n\"$opt(-buffer)\" n'est pas un buffer valide!\n"
        }
        set buf_isRect $xtext(buf,$opt(-buffer),isRect)
        set buf_data   $xtext(buf,$opt(-buffer),data)   
        # if {$::tcl_platform(os) == "Darwin"  && $opt(-buffer)=="clip"} {
        #     set buf_data [encoding convertfrom macRoman $buf_data]
        # }
        
    } elseif {[string length $opt(-string)]} {
        set buf_data   $opt(-string)
        set buf_isRect 0
        
    } else {
        set buf_data   [lindex $args 0]
        set buf_isRect 0
    }
    # L'utilisateur a t'il imposé la caractéristique "rectangulaire" ?
    # Si le mode rectangulaire est "auto" : on se base sur l'infermation
    # précédente
    if {[string equal $opt(-rect) "auto"]} {
        set opt(-rect) $buf_isRect
    }
    
    # évite un pushState au cas où il n'y aurait rien à faire
    # (e.g. on a tapé une touche non imprimable telle que <Control>)
    if {![string length $buf_data]} {
        return
    }
    
    # Doit-on sauvegarder l'état pour le undo ?
    if {![xtext_isDirty $w]} {
        # si le texte n'avait pas encore été modifié : on sauvegarde !
        xtext_pushState $w
        # # # xtext_markDirty $w
    } else {
        switch -exact -- $opt(-push) {
            auto {
                # On ne fait pas de pushState pour plusieurs insertion
                # consécutives.
                if {[$w compare $xtext($w,lastInsertPos) \
                                        != [$w index insert]]} {   
                    xtext_pushState $w
                } else {
                    # pas de push 
                }
            }
            0 {
                # pas de push
            }
            1 {
                # un push 
                xtext_pushState $w
            }
            default {
                error "\nOption \"-push $opt(-push)\" incorrecte !\n"
            }
        }
    }
    # report -v opt
    if {[string equal $opt(-index) "insert"]} {
        switch -exact -- $opt(-remsel) {
          0 {
              # Si elle existe, on ne touche pas à la sélection, mais on 
              # positionne l'insert en fin de sélection
              # 
              # PAS UTILE SI xtext_select s'en charge !
              # 
              # if {[xtext_hasSel $w]} {
              #     $w mark set insert [xtext_moveCursor $w -nomove -right 1]
              # }
          }
          1 {
              # Si elle existe, on déselectionne et on positionne l'insert
              # en fin de sélection
              if {[xtext_hasSel $w]} {
                  $w mark set insert [xtext_moveCursor $w -nomove -right 1]
              }
              xtext_getSel $w
              $w tag remove sel 1.0 end
          }
          default {
              error "Valeur non implémentée : -remsel $opt(-remsel)"
          }
        }
        switch -exact -- $opt(-delsel) {
          1 {
              xtext_delete__sel_nopush $w
          }
          0 {
              # On ne touche pas à la sélection
          }
          default {
              error "Valeur non implémentée : -delsel $opt(-delsel)"
          }
        }
    }
    
    # On modifie éventuellement le texte à insérer par le filter utilisateur 
    if {[info proc xtext_insertFilter_hook] != ""} {
        if {[catch {
            set buf_data [xtext_insertFilter_hook  $w  $buf_data]
        } msg]} {
            stead:log -error $msg
        }
    }
    

    if {$opt(-rect)} {
        set cmd [list xtext_insert__rect_nopush $w  \
                                        $opt(-index) $buf_data  $opt(-tags)]
    } else {
        set cmd [list $w insert $opt(-index) $buf_data  $opt(-tags)]
    }
    xtext_repeat $w -n $opt(-n) $cmd
    
    if {[string equal $opt(-index) "insert"]} {
        set xtext($w,lastInsertPos) [$w index insert]
        $w see insert
        xtext_updateFocusIn $w
    }

    # Traitement des parenthèses fermantes (pour surlignement temporaire)
    # TODO :
    #   - ne faire que si option de procedure -showBalance
    #   - améliorer efficacité en utilisant un tableau du style 
    #         xtext_balance_list($rightChar)
    #     Cette boucle serait alors remplacée par un simple test d'existence 
    #     de variable !
    # set opt(-balance) 0 ;# FORCAGE POUR TEST !!! XXXXXXXXXXXXXXX !!! 
    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"
            }
        }
    }
    if {$opt(-style)} {
        # update
        # set idx1 "$opt(-index)-[string length $buf_data]c linestart"
        # set idx2 "$opt(-index) lineend"
        # report  [list $idx1 $idx2]
        
        # Ne pas utiliser -currentLine permet plus de souplesse dans le range
        # xtext_style $w apply -currentLine
        xtext_style $w apply -range   [list \
               "$opt(-index)-[string length $buf_data]c linestart" \
               "$opt(-index) lineend" ]
    }
} ;# xtext_insert

## xtext_insert__rect_nopush -- insere du texte rectangulaire (**PRIVATE**)
# 
# Plus tard, on gérera la notion de "buffer" en tant qu'objet contenant
# sa propre information "isRect".
# Pour l'instant, pour faciler le passage stead36 -> stead83, on conserve
# la même api en passant en troisieme parametre une chaine et non pas le
# nom d'une variable (tableau ?) de type "buffer"
# 
proc xtext_insert__rect_nopush {w mark bufText {tags {}}} {
    if {![string length $bufText]} {
        # rien à faire
        return
    }
    set lines [split $bufText \n]
    set markLineNum [xtext_getLineNum $w $mark]
    set markColNum  [xtext_getColNum $w $mark]
    set bufWidth [string length [lindex $lines 0]]
    
    set lineN $markLineNum
    foreach line  $lines  {
        # On complète les lignes trop courtes (du widget) par des espaces
        while {[xtext_getColNum $w "$lineN.0 lineend"] < $markColNum} {
            $w insert $lineN.end " "
        }
        $w insert $lineN.$markColNum $line $tags
        incr lineN
    }
    # positionner l'insert droite de la sélection de la première ligne 
    $w mark set insert "$mark linestart + $markColNum c + $bufWidth c"
}


## xtext_insertDigit -- insere ou accumule le chiffre
# 
# En mode multi-évaluation : accumule l'argument numérique,
# En mode normal : affiche le chiffre dans le widget
#
# w :le widget text
# digitChar : le chiffre à accumuler ou à afficher suivant le mode
# 
# 
proc xtext_insertDigit { w digitChar } {
    global xtext
    if {$xtext($w,autoRepeatActif)} {
        xtext_autoRepeatAppendDigit $w $digitChar
    } else {
        xtext_insert $w -string $digitChar
    }
}

## xtext_delete -- procédure principale pour toutes suppression de texte
# 
#   xtext_delete w ?keyValues? rangesOrTags
# 
# Le texte à supprimer est donné sous forme d'une liste de tags 
# ou de paires d'indices.
# 
# options :
# 
# -push auto|0|1 (défaut : auto) effectue ou non un pushState pour le undo
#     Pour l'instant, le mode auto n'est pas tres intelligent et fait
#     en push systématiquement.
#     PROJET (à creuser) :
#     Un push sera fait si :
#     - l'insert n'a pas bougé depuis le dernier appel à cette procédure (i.e
#       on n'est pas allé cliquer ailleurs)
#     - **et si** on la chaine d'insertion ne fait que un caractère de long
#     
# -ranges {start1 end1 star2 end2 ...}
# -tags { tag1 tag2 ...} les tags à affecter au texte inséré
# -forward <n>   ou  -f <n>  
# -backward <n>  ou  -b <n>   
#     Détruit les <n> caracteres en avant ou en arrière du point 
#     d'insertion (avec fonctionnalité d'auto-répétition).
# -right <n>   ou   -r <n>  
# -left <n>    ou   -l <n>   
#     Détruit les <n> caracteres à droite ou à gauche du point 
#     d'insertion **sans jamais** déborder de la ligne courante
#     (avec fonctionnalité d'auto-répétition).
#     L'utilisation d'une de ces options s'il y a une sélection entraine
#     simplement la suppression de la sélection.
# 
# Cette proc détruit successivement et dans cet ordre :
#   - les tags donnés par l'option "-tags <tags>
#   - les intervales donnés par l'option "-ranges <ranges>"
#   - les tags ou intervales donnés en arguments supplémentaire.
# Les arguments supplémentaires sont alors interprétés si possible comme :
#   1 - des tags existants,
#   2 - des indices ou marques connues,
#   3 - des entiers numéro de ligne.
#   
# Si ni ranges ni tags ne sont proposés, alors le dernier argument est 
# lu et interpreté comme une liste de tags si possible ou sinon d'intervales
# formés de deux indices
# 
# Exemples :
# 
#           xtext_delete $w sel
#           xtext_delete $w all     ("all" est un tag inexistant mais simulé)
#           xtext_delete $w 15.0 "sel.first - 2c"
#           xtext_delete $w -b 2
#           xtext_delete $w  sel 327.4 "end-7l+3c" commentTag
#           xtext_delete $w -ranges $rangeSpec
#           xtext_delete $w -tags $tags
#           xtext_delete $w -- $tagsOrRange
#     
# 
proc xtext_delete {w args} {
    global xtext
    
    Parsarg_fullSpec -cache  opt {
        p -  push     { -type enum    -values {auto 0 1} }
        r -  right    { -type integer -default 0         }
        l -  left     { -type integer -default 0         }
        f -  forward  { -type integer -default 0         }
        b -  backward { -type integer -default 0         }
        
        style {
            -type boolean
            -default 1
            -label "si vrai : effectue la colorisation dynamique"
        }
                                                        
        tags     {}
        ranges   {}
    }
    # le reste est supposé etre une liste de tags ou de paires d'indices
    # set tagsOrIndexes [lindex $args 0]
    set tagsOrIndexes $args
    
    
    # Doit-on sauvegarder l'état pour le undo ?
    if {![xtext_isDirty $w]} {
        # si le texte n'avait pas encore été modifié : on sauvegarde !
        xtext_pushState $w
    } else {
        switch -exact -- $opt(-push) {
            auto {
                # On ne fait pas de pushState pour plusieurs delete
                # consécutifs.
                if {[$w compare $xtext($w,lastDeletePos) \
                                            != [$w index insert]]} {   
                    xtext_pushState $w
                } else {
                    # pas de push 
                }
            }
            0 {
                # pas de push
            }
            1 {
                # un push 
                xtext_pushState $w
            }
            default {
                error "\nOption \"-push $opt(-push)\" incorrecte !\n"
            }
        }
    }
    # 1 - traitement des option -right, -left, -backward et -forward
    if {$opt(-right) || $opt(-left) || $opt(-forward) || $opt(-backward)} {
        if {[xtext_hasSel $w]} {
            # S'il y a une sélection, le seul effet de cette procédure est
            # la suppression du texte sélectionné.
            xtext_pushState $w
            set selFirst [$w index sel.first]
            set selLast  [$w index sel.last]
            xtext_delete__sel_nopush $w
            # on recolorise la partie de texte modifiée
            if {$opt(-style)} {
                xtext_style $w apply -range      [list \
                       "$selFirst linestart"           \
                       "$selLast lineend+1c"      ]
            }                                   
            return
        }
    }
    if {$opt(-right)} {
        set nbChar [expr {$opt(-right) * [xtext_autoRepeat $w -get]}]
        set right [$w index "insert + $nbChar chars"]
        if {[$w compare $right > "insert lineend"]} {
            set right [$w index "insert lineend"]
        }
        lappend opt(-ranges) insert $right
    }
    if {$opt(-left)} {
        set nbChar [expr {$opt(-left) * [xtext_autoRepeat $w -get]}]
        set left [$w index "insert - $nbChar chars"]
        if {[$w compare $left < "insert linestart"]} {
            set left [$w index "insert linestart"]
        }
        lappend opt(-ranges) $left insert
    }
    if {$opt(-forward)} {
        set nbChar [expr {$opt(-forward) * [xtext_autoRepeat $w -get]}]
        lappend opt(-ranges)  insert [$w index "insert + $nbChar chars"]
    }
    if {$opt(-backward)} {
        set nbChar [expr {$opt(-backward) * [xtext_autoRepeat $w -get]}]
        lappend opt(-ranges) [$w index "insert - $nbChar chars"] insert
    }
    
    # 2 - pour les arguments résiduels, on va deviner si c'est des tags  ou
    #     des paires d'index, et les affecter au option -tags ou -ranges
    # 
    set existingTags [$w tag names]
    set i 0
    while {$i < [llength $tagsOrIndexes]}  {
    
        set toi [lindex $tagsOrIndexes $i]
        incr i

        if {[lsearch $existingTags $toi] != -1} {
            
            # C'est bien un tag existant : on complete la liste des tags
            # 
            lappend opt(-tags) $toi
            continue
            
        } elseif {[string equal "all" $toi]} {
            
            # On simule le tag "all" (qui n'existe pas)
            lappend opt(-ranges) 1.0 "end-1c"
            continue
        
        } else {
            # on suppose que c'est un indice ou une marque,
            
            if {[catch {set idx1 [$w index $toi] }  ]} {
                # Est-ce un numéro de ligne ? 
                # Alors on détruit à partir du début de celle-ci
                if {[string is integer $toi]} {
                    set idx1 $toi.0
                }
            }
            
            # On cherche donc l'indice de fin
            set toi2 [lindex $tagsOrIndexes $i]
            incr i
            
            if { ![string length $toi2] } {
                # indice manquant : on ne détruit que l'index indiqué !
                set idx2 $idx1
            } elseif {[catch {set idx2 [$w index $toi2] }  ]} {
                # est un numéro de ligne ? 
                # Alors on détruit jusqu'à la fin de celle-ci
                if {[string is integer $toi2]} {
                    set idx2 $toi2.end
                }
            }
            
            # La paire d'indice est définie : on complete la liste ranges
            # 
            lappend opt(-ranges) $idx1 $idx2
        }
    }
    # 3 - suppression des tags passés explicitement en option
    # 
    # Les limites à recoloriser éventuellement
    set colorFirst [$w index end]
    set colorLast  [$w index 1.0]
    foreach tag $opt(-tags) {
        if {[string equal $tag "sel"]} {
            # traitement spécial de la sélection
            if {[xtext_hasSel $w]} {
                set colorFirst [xtext_getFirstIndex $w \
                        $colorFirst [$w index sel.first]]
                set colorLast  [xtext_getLastIndex $w \
                        $colorFirst [$w index sel.last]]
                xtext_delete__sel_nopush $w
            }            
            continue
        }
        foreach {idx1 idx2} [$w tag ranges $tag]   {
            set colorFirst [xtext_getFirstIndex $w $colorFirst $idx1]
            set colorLast  [xtext_getLastIndex  $w $colorLast  $idx2]
            $w delete $idx1 $idx2
        }
    }
    # 4 - suppression des intervales passés explicitement en option
    foreach {idx1 idx2} $opt(-ranges) {
        set colorFirst [xtext_getFirstIndex $w $colorFirst $idx1]
        set colorLast  [xtext_getLastIndex  $w $colorLast  $idx2]
        $w delete $idx1 $idx2
    }
    # # 5 - recolorise entre les extremes des intervales effacés
    if {$opt(-style)} {
        # puts "selFirst=$selFirst selLast=$selLast"
        xtext_style $w apply -range   [list \
                    "$colorFirst linestart" \
                    "$colorLast  lineend" ]
    }                     
    set xtext($w,lastDeletePos) [$w index insert]
    xtext_updateCursorSize $w
    xtext_updateInsertPos $w
}

## xtext_delete__sel_nopush - efface selection affiche le curseur (interne)
# 
# Efface la selection dans le widget W et affiche le curseur
# Cette procédure de bas niveau est **privée** et n'est utilisée que 
# dans ce fichier     
#                       
# Pour une utilisation normale, utiliser plutot :
#       xtext_delete $w -push 0 sel
# ou la macro :
#       del -p 0 sel
# 
proc xtext_delete__sel_nopush {w} {
    global xtext
    
    if {[xtext_hasSel $w]} {
        set xtext(selectMode) char
        # à renommer xtext_recordSel $w ???
        xtext_getSel $w
        set selRanges [$w tag ranges sel]    
        foreach {startIdx endIdx}  $selRanges  {
            $w delete $startIdx $endIdx
        }
        xtext_updateCursorSize $w
        xtext_updateInsertPos $w
    }
    $w mark set anchor insert
    
}

#f######################################################################
#f  2 - selection/déselection (par clavier, souris ou autre)
#f      et de manipulation des marques (insert, ...)
#f######################################################################

#f######################################################################
#f  2 - selection/déselection (EXTRAIT)-
#f######################################################################

## xtext_hasSel -- vrai si w contient du texte sélectionné
# 
proc xtext_hasSel { w } {
    return [string compare [$w tag nextrange sel 1.0 end] ""]
}

## xtext_hasRectSel --  vrai si w contient une sélection restangulaire 
# 
# 
proc xtext_hasRectSel { w } {
    return [expr [llength [$w tag ranges sel] ] > 2]
}


## xtext_unSelect - déselectionne tout ou partie du texte
# 
# TODO : étendre pour déselectionner des intervales
#       xtext_select -remove ?first1 last1 first2 last2 ... ?
# 
proc xtext_unSelect { w } {
    global xtext
    set xtext(selectMode) char
    if {[xtext_hasSel $w]} {
        # On mémorise la sélection et son état isRect
        xtext_getSel $w
        $w tag remove sel 1.0 end
        xtext_updateFocusIn $w
    }
}

## xtext_select -- procédure principale pour toute sélection de texte
# 
#   xtext_select w ?keyValues? ?mark1? ?mark2?
# 
# argument : ?mark1? ?mark2? index de début et de fin (A FAIRE !!!)
# 
# options :
#    -mode <selectMode> : choix du mode de sélection, equivalent aux switchs
#          suivants
#    -char (flag) : étend sélection à des lignes completes
#    -word (flag) : étend sélection à des mot completes
#    -line (flag) : force sélection en mode ligne et l'étend (ou la crée)
#    -par (flag)  : force sélection en mode paragraphe (NON IMPLÉMENTÉ !)
#    -rect (flag) : force sélection en mode rectangulaire
#    -all  (flag) : sélectionne tout
# 
#    -what <string> : spécifie que faire avec la sélection, équivalent aux
#           switch suivants :
#    -set (flag par défaut) : remplace la sélection précédente par celle-ci
#    -add (flag) : ajout cette sélection à la précédente
#    -rem ou -remove (flag) : retranche de la sélection précédente (PEU TESTÉ)
#    -xor (flag) : complémente la sélection spécifiée (NON IMPLÉMENTÉ)
#                       
# Exemples : 
# 
#   A COMPLETER
# 
# 
# 
# TODO : A COMPLETER ... 
# pour en faire la proc standard de selection/deselection
#    - options : 
#        -to <index>  : étend la sélection jusqu'à index
#        -mode <para>
#       
proc xtext_select { w  args} {
    global xtext
    # 
    # 1 - extraction des options
    # 
    # BUG l'option -rem (alias -remove) ne fonctuionne pas alors que
    #     -remove fonctionne !

    Parsarg_fullSpec  opt {
        mode {
            -type   flagenum
            -values {char word line para rect all}
        }
        what {
            -type  flagenum
            -values {set add remove}
            -label "remplace, ajoute ou retranche à la sélection précédente"
        }
        rem {
            -alias remove
        }
    }
    set first [lindex $args 0]
    set last  [lindex $args 1]
    
    # 
    # 2 - Validation des vraies valeurs de first et last
    # 
    
    if {![string length $first]} {
        if {[xtext_hasSel $w]} {
            set first sel.first
        } else {
            set first "insert"
        }
    } 
    if {![string length $last]} {
        if {[xtext_hasSel $w]} {
            set last sel.last
        } else {
            set last "insert"
        }
    } 
    set first [$w index $first]
    set last  [$w index $last]

    if {[regexp -- {^char|word|line|rect$} $opt(-mode)]} {
        set xtext(selectMode) $opt(-mode)
    }
    switch -exact -- $opt(-mode) {
        rect -
        char {
           # rien à faire pour l'instant
        }
        word {
           
           if {[xtext_hasSel $w]} {
               # On étend la sélection à des mots entier
               
               # on cherche un début de mot
               set first [$w search -backward -regexp {\W\w} $first]
               if {[catch {set first [$w index $first+1c]} ]} {
                   set first 1.0
               }
               # on cherche une fin de mot
               set last  [$w search -forward  -regexp {\w\W} $last]
               if {[catch {set last [$w index $last]} ]} {
                   set last end
               }
                
           } else {
               # Si pas de sélection : on cherche le moment commençant
               # avant ou à l'insert
        
               # on cherche le début de mot courant ou précédent
               set first [$w search -backward -regexp {\W\w} $first]
               if {[catch {set first [$w index $first+1c]} ]} {
                   set first 1.0
               }
               # on cherche la fin de mot juste postérieure à $first
               set last  [$w search -forward  -regexp {\W} $first]
               if {[catch {set last [$w index $last]} ]} {
                   set last end
               }
           }
        }
        line {
           set first "$first linestart"
           set last  "$last -1c lineend+1c"
           # corrige un bug de stead quand le point d'insertion était en début
           # d'une ligne :
           if {[$w compare $first == $last]} {
               set last [$w index "$last lineend"]
           }
           
        }
        para {
           error {Le mode de sélection "para" n'est pas encore implémenté}
        }
        all {
           set first 1.0
           set last  end
        }
        default {
           error "mode de sélection\
                  xtext(selectMode)=\"$xtext(selectMode)\" incorrect !" 
        }
    } 
    
    # 
    # 3 - traitement de l'aspect remplacement (set) désélection (remove)
    #     ou additif (add) de la sélection.
    # 
    switch -exact -- $opt(-what) {
        "remove" {
            set setOrRem "remove"
        }
        "add" {
            set setOrRem "add"
        }
        "set" -
        default {
            $w tag remove sel 1.0 end
            set setOrRem "add"
        }
        
    }
    # 
    # 3 - selection ou délection entre first et last en fonction du mode
    #     (rectangulaire ou non)
    
    switch -exact -- $opt(-mode) {
        char -
        word - 
        line -
        para -
        all {
            $w tag $setOrRem sel $first $last
            $w mark set insert $last
            $w mark set anchor $first
        }
        rect {
            # EN COURS DE DEVELOPPEMENT !!
            set leftCol    [xtext_getLeftColNum  $w $first $last ]
            set rightCol   [xtext_getRightColNum $w $first $last ]
            set topLineNum [xtext_getTopLineNum  $w $first $last ]
            set botLineNum [xtext_getBotLineNum  $w $first $last ]
            
            # Pour chaque numéro de ligne à sélectionner
            # 
            set lineNum $topLineNum
            while {$lineNum <= $botLineNum} { 
                # On sélectionne l'intervale intéressant. 
                # Si la ligne est trop courte, on sélectionne jusqu'à la 
                # fin de la ligne.
                $w tag $setOrRem sel $lineNum.$leftCol $lineNum.$rightCol
                $w mark set insert $topLineNum.$rightCol
                incr lineNum
            }
            # On positionne l'insert à droite de la premiere ligne 
            # selectionnée
            $w mark set insert [xtext_moveCursor $w -nomove -right 1]
            $w mark set anchor [xtext_moveCursor $w -nomove -left  1]
        }
    }
    xtext_updateCursorSize $w
}

# ## xtext_selectRectTo -- Mon ancienne sélection rectangulaire avant fusion.
# ##                       A garderprovisoirement pour les cas d'urgence !!!
# # 
# # Effectue une selection rectangulaire entre l'insert ou (sel.first) 
# # et la marque passée en parametre (dans le widget t)
# # 
# # ENCORE UTILISE DANS les fichiers suivants :
# #   xtext/xtext.tcl
# # 
# # N'EST PLUS UTILISÉE (diam le 05/11/01)
# # 
# proc xtext_selectRectTo { w  mark  {doRectSel 1} } {
#     
#     set leftCol    [xtext_getLeftColNum  $w insert $mark ]
#     set rightCol   [xtext_getRightColNum $w insert $mark ]
#     
#     set lineNum    [xtext_getTopLineNum  $w insert $mark]
#     set botLineNum [xtext_getBotLineNum  $w insert $mark]
#     
#     if {[xtext_hasSel $w]} {
#         $w tag remove sel sel.first sel.last
#     }
#       
#     # Pour chaque numéro de ligne à sélectionner
#     # 
#     while {$lineNum <= $botLineNum} { 
#         
#         # On sélectionne l'intervale intéressant (même si la ligne
#         # est trop courte : on sélectionne jusqu'à la fin de la ligne)
#         $w tag add sel $lineNum.$leftCol $lineNum.$rightCol
#         incr lineNum
#         
#     }
#     xtext_updateCursorSize $w
# }

## xtext_selectTo --
# 
# xtext_selectTo w ?options? x y
# 
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line or rect) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w -        The text window in which the button was pressed.
# x -        Mouse x position.
# y -        Mouse y position.
# 
# options:
# -m <mode>
# -mode <mode> : affecte le mode de sélection. les valeurs possibles sont :
#       char, word, line et rect
# 
# A FAIRE :
#  - prévoir aussi (plus tard !) ajout parametre {extend 0} (cf tk8.4)
#  
#  - URGENT : en faire une surcouche à la procédure "xtext_select"
# 
proc xtext_selectTo {w args} {
    global xtext
    Parsarg_fullSpec opt {
        m -
        selectMode  -
        mode  {
            -variable xtext(selectMode)
            -regexp   {^char|word|line|rect$}
        }
        c -
        char {
            -type flag
            -variable xtext(selectMode)
            -value char
        }
        w -
        word {
            -type flag
            -variable xtext(selectMode)
            -value word
        }
        l -
        line {
            -type flag
            -variable xtext(selectMode)
            -value line
        }
        r -
        rect {
            -type flag
            -variable xtext(selectMode)
            -value rect
        }
    }
    set x [lindex $args 0]
    set y [lindex $args 1]

    # conserver xtext_closestGap meme si commenté
    # set cur [xtext_closestGap $w $x $y]
    set cur [$w index @$x,$y]
    if {[catch {$w index anchor}]} {
        $w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if {[$w compare $cur != $anchor] || (abs($xtext(pressX) - $x) >= 3)} {
        set xtext(mouseMoved) 1
    }
    set  first [xtext_getFirstIndex $w $cur anchor]
    set  last  [xtext_getLastIndex  $w $cur anchor]
    if {$xtext(mouseMoved) || ($xtext(selectMode) != "char")} {
    
        $w tag remove sel 0.0 end
        
        switch $xtext(selectMode) {
            char {
                $w tag add sel $first $last
                $w mark set insert $last
            }
            word {
                # on sélectionne le mot englobant ou précédent (A AMELIORER)
                set first [xtext_prevPos $w "$first + 1c" tcl_wordBreakBefore]
                set last  [xtext_nextPos $w "$last"       tcl_wordBreakAfter]
                $w tag add sel $first $last
                $w mark set insert $last
            }
            line {
                set first "$first linestart"
                set last  "$last -1c lineend+1c"
                $w tag add sel $first $last
                $w mark set insert $last
            }
            rect {
                # EN COURS DE DEVELOPPEMENT !!
                set leftCol    [xtext_getLeftColNum  $w $first $last ]
                set rightCol   [xtext_getRightColNum $w $first $last ]
                set topLineNum [xtext_getTopLineNum  $w $first $last ]
                set botLineNum [xtext_getBotLineNum  $w $first $last ]
                
                # Pour chaque numéro de ligne à sélectionner
                # 
                set lineNum $topLineNum
                while {$lineNum <= $botLineNum} { 
                    # On sélectionne l'intervale intéressant. 
                    # Si la ligne est trop courte, on sélectionne jusqu'à la 
                    # fin de la ligne.
                    $w tag add sel $lineNum.$leftCol $lineNum.$rightCol
                    $w mark set insert $topLineNum.$rightCol
                    incr lineNum
                }
                # On positionne l'insert à droite de la premiere ligne 
                # selectionnée
                $w mark set insert [xtext_moveCursor $w -nomove -right 1]
            }
        }
        
        # Ceci était dans la lib tk8 : à conserver en commentaire !
        # $w tag remove sel 0.0 $first
        # $w tag add sel $first $last
        # $w tag remove sel $last end
        # update idletasks
    }
    # Modif diam le 11/10/01 : 
    # 
    # Il n'est pas forcément nécessaire de mémoriser la sélection.
    # Par ailleurs cette mémorisation ne ralenti pas du tout le comportement
    # du balayage de la sélection !
    # 
    # xtext_getSel $w
    # 
    # Par contre updateCursorSize ralentit ce balayage !  
    # Mais permet de faire disparaitre le curseur pendant un balayge 
    # de sélection
    # 
    xtext_updateCursorSize $w
}

## xtext_getSel -- retourne le contenu de la sélection (éventuellement vide)
# 
# w : widget text
# 
# option :
# 
#   -ifnosel <oldsel | empty | error>
#   
# Principe :
# 
#  1 - si le widget text n'est pas propriétaire de la sélection 
#      1.1 - s'il n'existe aucune sélection, retourne la sélection
#            précédente.
#      1.2 - s'il y a une sélection dans une autre appli :
#            retourne cette sélection.
#  2 - s'il y a une sélection continue dans le widget : retourne 
#      cette sélection et on positionne l'information "non rectangulaire"
#  3 - s'il y a une sélection discontinue dans le widget : retourne 
#      cette sélection en égalisant la longueur des lignes et on positionne 
#      'information "rectangulaire"
# 
#  Dans tous les cas, les variables suivante sont positionnées :
#       - xtext(buf,oldSel,data)
#       - xtext(buf,oldSel,isRect)
# 
# Exemple :
# 
#   xtext_getSel $w
#           Enregistre la sélection dans le buffer "oldSel"
#   xtext_getSel $w -buffer clip 
#           Enregistre la sélection dans le buffer "clip"  (A FAIRE)
#           
#           
# 
proc xtext_getSel {w args} {
    global xtext
    upvar 0 xtext(buf,oldSel,data)     oldSel_data
    upvar 0 xtext(buf,oldSel,isRect)   oldSel_isRect
    
    Parsarg_fullSpec opt {
        ifnosel  {
            -default  "oldsel"
            -regexp {^oldsel|empty|error$}
            -label   {En l'absence de sélection : "oldsel", "empty"ou "error" ?}
        }
    }

    # 1 - Cas où si le widget text n'est pas propriétaire de la sélection
    # 
    if {![xtext_hasSel $w]} {
        if {[catch {selection get -displayof $w} s]} {
            # 1.1 - s'il n'existe de sélection nul part
            switch -exact -- $opt(-ifnosel) {
                empty {
                    set oldSel_data ""
                    set oldSel_isRect 0
                    return $oldSel_data
                }
                error {
                    error "Il n'y a aucune sélection !"
                }
                oldsel -
                default {
                    # on ne touche pas à l'ancienne sélection qu'on retourne
                    return $oldSel_data
                }
            }
        } {
            # 1.2 - Une autre appli possède la sélection
            set oldSel_data $s
            set oldSel_isRect 0            
            
            return $oldSel_data
        }
    }
    
    # 2 - Si la sélection existe, mais n'est pas rectangulaire, on le retourne
    #     simplement.
    # 
    if {![xtext_hasRectSel $w]} {
        set oldSel_isRect 0
        set oldSel_data   [selection get]
        return $oldSel_data
    }
    
    # 2 - Il y a une sélection, et elle est rectangulaire (i.e discontinue).
    # 
    
    # On va ajouter chaque intervale de la sélection rectangulaire au buffer.
    # 
    # Puis on s'assure que toutes les lignes ont même longueur en ajoutant 
    # des espaces.
    # Hyp : on a au maximum un intervale de sélection par ligne !
    # 
    set lines [list]
    set lineNum [xtext_getLineNum $w sel.first]
    
    foreach {idx1 idx2} [$w tag range sel] {
        # Trip : on ajoute au minimume un "\n" par ligne, même si la ligne est 
        # trop courte pour avoir été sélectionnée (ex. ligne vide)
        while {$lineNum < [xtext_getLineNum $w $idx1]} {
            # On traite une ligne non sélectionnée car trop courte
            lappend lines ""
            incr lineNum
        }
        lappend lines [$w get $idx1 $idx2]
        incr lineNum
    }
    # On calcule la plus grande longueur de ligne 
    set maxLength 0
    foreach line  $lines  {
        set thisLength [string length $line]
        if {$thisLength > $maxLength} {
            set maxLength $thisLength
        }
    }
    
    # Création des données du buffer 
    foreach line  $lines  {
        # formatage à gauche de longueur $maxLength
        append buffer [format "%-${maxLength}s" $line]\n
    }
    set oldSel_isRect 1
    set oldSel_data   $buffer
}

## xtext_closestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
# of the character just after the boundary.
#
# Arguments:
# w -        The text window.
# x -        X-coordinate within the window.
# y -        Y-coordinate within the window.
# 
# A FAIRE :
#   créer xtext_closestGapOnSameLine pour éviter de sélectionner
#   la ligne au-dessus sous pretexte qu'elle est plus proche
# 
proc xtext_closestGap {w x y} {
    set pos [$w index @$x,$y]
    set bbox [$w bbox $pos]
    if {![string compare $bbox ""]} {
        return $pos
    }
    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
        return $pos
    }
    $w index "$pos + 1 char"
}


## xtext_selectionStart --
# This procedure is invoked to handle button-1 presses in text
# widgets.  It moves the insertion cursor, sets the selection anchor,
# and claims the input focus.
#
# Arguments:
# w -        The text window in which the button was pressed.
# x -        The x-coordinate of the button press.
# y -        The x-coordinate of the button press.
# 
# option :
#   -mode <mode> (ou -m <mode>): impose le mode de sélection 
#       lLs modes autorisés sont char | word | line | rect
#   -char , -word, -line, -rect (ou leur initiale)
#       impose le mode correspondant
#  
proc xtext_selectionStart {w args} {
    global xtext

    # le tableau opt est passé par variable, mais est inutile ici car seule
    # car seule la variable (globale)  xtext(selectMode) sera affectée
    # Dans cette procédure, xtext(selectMode) **doit**avoir une valeur par 
    # défaut (i.e "char")
    Parsarg_fullSpec opt {
        m -
        selectMode  -
        mode  {
            -type     flagenum
            -values   {char word line rect}
            -variable xtext(selectMode)
        }
        c   {-alias char}
        w   {-alias word}
        l   {-alias line}
        r   {-alias rect}
    }
    set x [lindex $args 0]
    set y [lindex $args 1]
    # # # set xtext(selectMode) $opt(-mode)
    set xtext(mouseMoved) 0
    set xtext(pressX) $x
    # $w mark set insert [xtext_closestGap $w $x $y]
    $w mark set insert [$w index @$x,$y]
    $w mark set anchor insert
    if {[$w cget -state] == "normal"} {
        focus $w
    }
    xtext_updateFocusIn $w
}

## xtextCancelRepeat --
#
# This procedure is invoked to cancel an auto-repeat action described
# by tkPriv(afterId).  It's used by several widgets to auto-scroll
# the widget when the mouse is dragged out of the widget with a
# button pressed.
#
# (skip from tk library)
#
proc xtext_cancelRepeat {} {
     global xtext
     after cancel $xtext(afterId)
     set xtext(afterId) {}
}

## xtext_autoScan --
# This procedure is invoked when the mouse leaves a text window
# with button 1 down.  It scrolls the window up, down, left, or right,
# depending on where the mouse is (this information was saved in
# xtext(x) and xtext(y)), and reschedules itself as an "after"
# command so that the window continues to scroll until the mouse
# moves back into the window or the mouse button is released.
#
# Arguments:
# w -        The text window.
# 
proc xtext_autoScan {w} {
    global xtext
    
    if {![winfo exists $w]} return
    if {$xtext(y) >= [winfo height $w]} {
        $w yview scroll 2 units
    } elseif {$xtext(y) < 0} { 
        $w yview scroll -2 units
    } elseif {$xtext(x) >= [winfo width $w]} { 
        $w xview scroll 2 units
    } elseif {$xtext(x) < 0} { 
        $w xview scroll -2 units
    } else {
        return
    }
    xtext_selectTo $w -- $xtext(x) $xtext(y)
    # Voir par defaut de tk = 50
    set xtext(afterId) [after 10 xtext_autoScan $w]
    # 26/11/01 (diam) 
    # rajout update pour éviter enballer de l'autoscroll 
    update
}

## xtext_setCursor
# 
# Move the insertion cursor to a given position in a text.  Also
# clears the selection, if there is one in the text, and makes sure
# that the insertion cursor is visible.  Also, don't let the insertion
# cursor appear on the dummy last line of the text.
#
# Arguments:
# w -    The text window.
# pos -    The desired new position for the cursor in the window.
# 
proc xtext_setCursor {w pos} {

    if {[$w compare $pos == end]} {
        set pos {end - 1 chars}
    }
    $w mark set insert $pos
    $w tag remove sel 1.0 end
    $w see insert
    xtext_updateFocusIn $w
}

## xtext_keySelect
# 
# This procedure is invoked when stroking out selections using the
# keyboard.  It moves the cursor to a new position, then extends
# the selection to that position.
#
# Arguments:
# w -       The text window.
# new -     A new position for the insertion cursor (the cursor hasn't
#           actually been moved to this position yet).
# 
# Utilisé par : xtextInitBindings (dans xtext.tcl)
# 
proc xtext_keySelect {w new} {

    if {[$w tag nextrange sel 1.0 end] == ""} {
        if {[$w compare $new < insert]} {
            $w tag add sel $new insert
        } else {
            $w tag add sel insert $new
        }
        $w mark set anchor insert
    } else {
        if {[$w compare $new < anchor]} {
            set first $new
            set last anchor
        } else {
            set first anchor
            set last $new
        }
        $w tag remove sel 1.0 $first
        $w tag add sel $first $last
        $w tag remove sel $last end
    }
    $w mark set insert $new
    $w see insert
    # Si la sélection disparait ou apparait : mise a jour taille curseur
    xtext_updateCursorSize $w
}

## xtext_resetAnchor -- positionne anchor à l'extrémité la plus éloignée de sel
# 
# Set the selection anchor to whichever end is farthest from the
# index argument.  One special trick: if the selection has two or
# fewer characters, just leave the anchor where it is.  In this
# case it doesn't matter which point gets chosen for the anchor,
# and for the things like Shift-Left and Shift-Right this produces
# better behavior when the cursor moves back and forth across the
# anchor.
#
# Arguments:
# w -    The text widget.
# index -  Position at which mouse button was pressed, which determines
#        which end of selection should be used as anchor point.
# 
proc xtext_resetAnchor {w index} {
    global xtext

    if {[$w tag ranges sel] == ""} {
        # modif diam 26/10/01 : si pas de sélection on la créera
        # Permet de créer la sélection par <Shift-B1> par exemple
        # 
        # # $w mark set anchor $index
        $w mark set anchor insert
        $w mark set insert $index
        return
    }
    set a [$w index $index]
    set b [$w index sel.first]
    set c [$w index sel.last]
    if {[$w compare $a < $b]} {
        $w mark set anchor sel.last
        return
    }
    if {[$w compare $a > $c]} {
        $w mark set anchor sel.first
        return
    }
    
    # L'insert est entre sel.first et sel.last
    # 
    scan $a "%d.%d" lineA chA
    scan $b "%d.%d" lineB chB
    scan $c "%d.%d" lineC chC
    if {$lineB < $lineC+2} {
        set total [string length [$w get $b $c]]
        if {$total <= 2} {
            return
        }
        if {[string length [$w get $b $a]] < ($total/2)} {
            $w mark set anchor sel.last
        } else {
            $w mark set anchor sel.first
        }
        return
    }
    if {($lineA-$lineB) < ($lineC-$lineA)} {
        $w mark set anchor sel.last
    } else {
        $w mark set anchor sel.first
    }
}

## xtext_scrollPages --
# 
# This is a utility procedure used in bindings for moving up and down
# pages and possibly extending the selection along the way.  It scrolls
# the view in the widget by the number of pages, and it returns the
# index of the character that is at the same position in the new view
# as the insertion cursor used to be in the old view.
#
# Arguments:
# w -    The text window in which the cursor is to move.
# count -  Number of pages forward to scroll;  may be negative
#        to scroll backwards.
# 
proc xtext_scrollPages {w count} {
    set bbox [$w bbox insert]
    $w yview scroll $count pages
    if {$bbox == ""} {
        return [$w index @[expr {[winfo height $w]/2}],0]
    }
    return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
}

## xtext_updateCursorSize -- met à jour la largeur du curseur
# 
# La taille cursor est nulle en cas de selection 
# Si cette procédure n'est pas appeler quand la sélection disparait :
# le curseur est invisible !
# 
# 
proc xtext_updateCursorSize {w} {
    
    global EDITPREFS
    
    if {[xtext_hasSel $w]} {
        $w configure -insertwidth 0
        $w tag raise sel
    } else {
        $w configure -insertwidth $EDITPREFS(textiw)
    }
    
}

## xtext_updateInsertPos -- Met à jour la variable contenant la postion 
#                             de l'insert
# 
# anciennemnt s'appelait "te:cmd:show_position"
# Mais cette ancienne procédure accédait direction au widget alors
# que celle-ci se contente de modifier une variable. C'est à l'application
# (stead) d'exploiter cette variable comme elle l'entend.
# 
proc xtext_updateInsertPos {w} {
    global xtext
    set xtext($w,insertPos) [$w index insert]
}


## xtext_updateFocusIn -- met plusieurs parametres à jour sur FocuIn
# 
# 
# En effet, la taille curseur nul en cas de selection n'est pas toujours 
# restorée !
# Question : tk8 propose de différencier les texte suivant l'état
# (dans la proc text_paste...)
#   if {[$w cget -state] == "normal" } {focus $w}
# 
proc xtext_updateFocusIn {w} {
    
    xtext_updateCursorSize $w
    
    # intégration de l'ancien te:cmd:show_position
    # Mise à jour du label "numéro de ligne"
    xtext_updateInsertPos $w
    
    # # diam : je ne sais jamais lequel des 2 updates il faut  utiliser !
    # # update idletask
    # update 
}

########################################################################
# DEBUT - Gestion du scroll et de la mise à jour des styles
########################################################################


## xtext_updateScrollMarks -- met à jour les marques screenStart et screenEnd
# 
# Met à jour les marques screenStart et screenEnd en fonction de la position 
# courante de la partie visible de l'écran.
# - screenStart en positionné sur le premier caractere de la première ligne
#   visible de l'écran (subtilité si on utilise le scroll en X)
# - screenEnd est positionné sur le premier caractere de la ligne qui suit
#   la dernière ligne visible de l'écran
# 
# Nota : 
#    Pas 100% fiable pour l'instant : je ne suis pas sûr le la
#    signification exacte de la comme tk "$w yview" 
# 
proc xtext_updateScreenMarks {w} {
    global xtext
    global xtext_style

    # endIdx : nbre total de lignes dans le text (e.g. 182.0)
    set endIdx    [$w index end]
    
    # on a par exemple : [$w yview] == {0.0331492 0.254827}
    set startLine [expr {round([lindex [$w yview] 0]*$endIdx)} ]
    set endLine   [expr {round([lindex [$w yview] 1]*$endIdx)} ]
    $w mark set screenStart "$startLine.0"
    $w mark set screenEnd   "$endLine.0+1line"

    # On n'envoie ce meta-event que :
    # - et si l'écran à changé de position
    set bool [expr {
        [$w compare old_screenStart != screenStart]
                    || [$w compare old_screenEnd != screenEnd] } ]
    
    if { $bool} {
        # report "Emission de <<screenChange>>"
        event generate $w <<screenChange>>
        $w mark set old_screenStart screenStart
        $w mark set old_screenEnd   screenEnd
    }
}
proc stead:updateYscroll_scrollbar {textWidget args} {
    global stead
    upvar #0 stead(text) w
    eval $w yview $args
    
    # Il ne semble pas que les deux lignes suivantes soient nécessaire !
    # update
    # xtext_updateScreenMarks $w
}
proc stead:updateYscroll_xtext {scrollWidget args} {

    global stead
    global xtext
    upvar #0 stead(text) w
    eval $scrollWidget set $args
    # report "updateYscroll_xtext"
    xtext_updateScreenMarks $w
}

bind XText <<screenChange>> {


    set bool [expr {
        [$w compare old_screenStart != screenStart]
                    || [$w compare old_screenEnd != screenEnd] } ]
    
    # report -v bool xtext(screenChangeSent)
                 
    # On n'envoie ce meta-event que :
    # - et si l'écran à changé de position
    # - et si l'évènement <<screenChange>> prcédent à été consommé
    # 
    if { $bool && !$xtext(screenChangeSent)} {
        
        # On accuse réception du traitement du meta-event <<screenChange>>
        set xtext(screenChangeSent) 1

        # report "screenChange : [$w index screenStart] [$w index screenEnd] \
        #         xtext_style %W apply -screen "
                
        # Cette procédure est succeptible de faire des updates et donc
        # donc provoquer  une réentrance  (d'où xtext(screenChangeSent) !)

        xtext_style $w apply -screen
        
        # On accuse réception du traitement du meta-event <<screenChange>>
        set xtext(screenChangeSent) 0
    } else {
        # BIDOUILLE EN TEST XXXX
        # report " On mémorise dans bind <<screenChangeSent>> !"
        set ::xtext_style($w,nextRequestCmd) "xtext_style__apply $w -screen"
        after cancel [list xtext_style__apply $w -screen]
        after 200 [list xtext_style__apply $w -screen]
    }
    
}

## xtext_getScreenRange -- retourne la paire d'index visible (COMMENT !!)
##                         OBSELETE PAR xtext_updateScrollMarks
# 
# Retourne une paire d'indice correspondant à la partie vsible du texte.
#   - indice du premier caractère de la première ligne visible
#   - indice du premier caractère suivant la dernière ligne visible
#     (correspond au premier caractere invisible)
# 
# option :
#   -addlinesnum <lineNum> : élargit l'intervale du nombre de lignes spécifié
#        (0 par défaut).
#       
#   
# Exemple :
#   set pair [xtext_getScreenRange $w]
#       => 1367.0 1407.0
#       
#   set pair [xtext_getScreenRange $w 1]
#       => 1366.0 1408.0
# 
# proc xtext_getScreenRange {w {addlinesnum 0}} {
#     
#     # endIdx : nbre total de lignes dans le text (e.g. 182.0)
#     set endIdx    [$w index end]
#     
#     # on a par exemple : [$w yview] == {0.0331492 0.254827}
#     set startLine [expr {round([lindex [$w yview] 0]*$endIdx)} ]
#     set endLine   [expr {round([lindex [$w yview] 1]*$endIdx)} + 1]
#     set startIdx  [$w index "$startLine.0 - $addlinesnum line"]
#     set endIdx    [$w index "$endLine.0   + $addlinesnum line"]
#     return [list $startIdx  $endIdx]
# }

########################################################################
# FIN - Gestion du scroll et de la mise à jour des styles
########################################################################

#f######################################################################
#f  3 - les commandes de manipulation du presse-papier (cut/copy/paste)
#f      et de mémorisation de la sélection
#f  
#f  Remarque sur le buffer ("clip", "oldSel", ...)
#f Ils représente un objet contenant à la fois les donnée de texte brutes
#f et l'information "isRect"
#f Pour l'instant, seul les buffer "clip" et "oldSel" existe, mais on
#f pourra créer plusieurs presse-papier...
#f Les variables suivantes sont donc définies :
#f 
#f     xtext(buf,oldSel,data)
#f     xtext(buf,oldSel,isRect)
#f     xtext(buf,clip,data)
#f     xtext(buf,clip,isRect)
#f 
#f######################################################################

## xtext_cut - copie la sélection dans le pesse-papier et la supprime
# 
# 
proc xtext_cut {w} {
    global xtext
    if {[xtext_hasSel $w]} {
        set xtext(buf,clip,isRect) [xtext_hasRectSel $w]
        set xtext(buf,clip,data)   [xtext_getSel $w]
        # # if {$::tcl_platform(os) == "Darwin"} {
        # #     set xtext(buf,clip,data) [encoding convertto macRoman $xtext(buf,clip,data)]
        # # }
        
        clipboard clear -displayof $w
        clipboard append -displayof $w $xtext(buf,clip,data)
        if {$::tcl_platform(os) == "Darwin"} {
            exec pbcopy << $xtext(buf,clip,data)
        }
        
        xtext_delete $w -push 1 sel
        stead:log "Cut: [string length $xtext(buf,clip,data)] chars" 
    } else {
        stead:log -error "Cut: no Selection in Text" 
    }
}

## xtext_cutToAppleClip  - coupe la selection dans le presse-papier APPLE
# 
#   - utilise l'exécutable pbcopy
#   - assure le trancode vers macRoman
# 
proc xtext_cutToAppleClip {w} {
    global xtext
    xtext_cut $w
    set appleClip [encoding convertto macRoman $xtext(buf,clip,data)]
    catch [list exec pbcopy << $appleClip]
}
## xtext_copyToAppleClip  - copie la selection dans le presse-papier APPLE
# 
#   - utilise l'exécutable pbcopy
#   - assure le trancode vers macRoman 
# 
proc xtext_copyToAppleClip {w} {
    global xtext
    xtext_copy $w
    set appleClip [encoding convertto macRoman $xtext(buf,clip,data)]
    catch [list exec pbcopy << $appleClip]
}
## xtext_pasteFromAppleClip  - copie la selection dans le presse-papier APPLE
# 
#   - utilise l'exécutable pbpaste
#   - assure le trancode depuis macRoman
proc xtext_pasteFromAppleClip {w} {
    global xtext
    catch [list set appleClip [exec -keepnewline pbpaste]] {
        stead:log  -error "xtext_pasteFromAppleClip : problème !" 
    }
    set xtext(buf,clip,data) [encoding convertfrom macRoman $appleClip]
    # NE PAS remettre isRect à 0 !! sinon le copie rect ne marche jamais !) 
    # set xtext(buf,clip,isRect) 0 
    xtext_paste $w
}
## xtext_copy  - copie la selection dans le presse-papier
# 
# A FAIRE : 
#   Gérer le presse-papier système
# 
proc xtext_copy {w} {
    global xtext

    if {[string length [xtext_getSel $w]]} {
        set xtext(buf,clip,isRect) [xtext_hasRectSel $w]
        set xtext(buf,clip,data)   [xtext_getSel $w]
        # # if {$::tcl_platform(os) == "Darwin"} {
        # #     set xtext(buf,clip,data) [encoding convertto macRoman $xtext(buf,clip,data)]
        # # }

        clipboard clear -displayof $w
        clipboard append -displayof $w $xtext(buf,clip,data)
        # # if {$::tcl_platform(os) == "Darwin"} {
        # #     exec pbcopy << $xtext(buf,clip,data)
        # # }
        
        stead:log "Copy: [string length $xtext(buf,clip,data)] chars" 
    } else {
        stead:log  -error "Copy: No selection" 
    }
}

## xtext_getClip  - retourne le texte de presse-papier
# 
# 
proc xtext_getClip {w} {
    global xtext
    # if {$::tcl_platform(os) == "Darwin"} {
    #     return encoding convertfrom macRoman $xtext(buf,clip,data)
    # } else {
    #     return $xtext(buf,clip,data)
    # }
    return $xtext(buf,clip,data)
    
}

     
## xtext_paste - copie le presse-papier dans le texte
#   
# A FAIRE : 
# 
#   1 - Gérer le presse-papier système
#   2 - Prévoir une autre proc pour inserer sous la souris
#       (activée par <Control-B2>)
#       <Control-B1> permettant de sélectionner sans déplacer l'insert
#       Créer les procédures :
#           xtext_paste_xy 
#           xtext_xpaste_xy 
#       En utilisant :
#           $w mark set insert [xtext_closestGap $w $x $y]
# 
# Remarque :
# La proc paste d'origine de la lib tk gérant comme suit :
#    $w insert insert [selection get -displayof $w -selection CLIPBOARD] 
# 
proc xtext_paste {w args} {
    global xtext
    Parsarg_fullSpec opt {
        tags  {
            -default  {}
            -label   "Liste de tags à appliquer au texte inséré."
        }
    }
    if {[info procs stead:paste_pre_hook] != {}} {
        stead:paste_pre_hook $w
    }
    if {![string length $xtext(buf,clip,data)]} {
        # puts "XXXXX-xtext(buf,clip,data=$xtext(buf,clip,data"
        stead:log -error "Paste: Buffer is empty" 
        return
    }
    xtext_pushState $w
    if {[xtext_hasSel $w]} {
        # Modif diam le 17/02/2003
        # Le -style 0 évite le bug produit quand on impose une recoloration 
        # intermédiaire entre la suppression de la sélection et l'insertion 
        # du nouveau texte.
        #     xtext_delete $w -push 0  sel 
        xtext_delete $w -push 0 -style 0 sel 
    }
    xtext_insert $w  -push 0  -buffer "clip"
    xtext_updateInsertPos $w
    $w see insert
    if {[info procs stead:paste_post_hook] != {}} {
        stead:paste_pre_hook $w
    }
}

## xtext_xpaste - insère la sélection courante ou précédente à l'insert
# 
# Exemple :
#    bind XText <$stead(Meta)-d>    {xtext_xpaste %W -tags sel}
# 
proc xtext_xpaste {w args} {
    global xtext
    Parsarg_fullSpec opt {
        tags  {
            -default  {}
            -label   "Liste de tags à appliquer au texte inséré."
        }
    }
    if {[info procs stead:xpaste_pre_hook] != {}} {
        stead:xpaste_pre_hook $w
    }
    set selection [xtext_getSel $w]
    if {![string length $selection]} {
        stead:log -error "Xpaste: no selection" 
        return
    }
    xtext_pushState $w         
    if {[xtext_hasSel $w]} {
        # Peut etre nécessaire pour choisir où on veut insérer par
        # rapport à la selection courante (pour <Meta-d> ?)
        # 
        # $w mark set insert sel.first       
    }
    xtext_insert $w -push 0  -delsel 0 -remsel 1 \
                    -tags $opt(-tags) -buffer oldSel
               
    if {[info procs stead:xpaste_post_hook] != {}} {
        stead:xpaste_pre_hook $w
    }
}


#f######################################################################
#f  4 - les commandes modification secondaires (DeleteLeft, KillLine,..)
#f######################################################################

## xtext_deleteRight w - delete character at insert
# 
proc xtext_deleteRight { w } {

    # si pas de selection dans le texte effacement du caractere a droite 
    # du curseur
    if { ![xtext_hasSel $w] } {
        if [$w compare insert != end] {
            xtext_pushState
            xtext_repeat $w {
                $w delete insert
            }
            xtext_markDirty $w
        } 
    } else {
        # sinon effacement de la selection
        xtext_pushState
        xtext_delete $w -push 0  sel 
        xtext_markDirty $w
    }
    xtext_updateInsertPos $w
    
}

## xtext_deleteLeft w - delete character before insert
# 
proc xtext_deleteLeft { w } {
    global xtext

    # si le texte est propre ou si on a change de position par rapport au point
    # d'insertion precedent, on effectue un checkpoint
    # on marque le texte "sale"
    append xtext(delete_left_insert) {}
    if {"x$xtext(delete_left_insert)" == "x"} {
      set xtext(delete_left_insert) [$w index "insert -1 chars"]
    }

    # si pas de selection dans le texte effacement du caractere a gauche 
    # du curseur
    if { ![xtext_hasSel $w] } {
      
        if [$w compare insert != 1.0] {
            # sauvegarde de l'information des Undo si on n'est pas au 
            # debut du texte
            if {![xtext_isDirty $w] || \
                      ($xtext(delete_left_insert) != [$w index insert])} {  
                xtext_pushState
            }
            xtext_repeat $w {
                $w delete {insert - 1 char}
            }
            xtext_markDirty $w
            set xtext(delete_left_insert) [$w index insert]
        }
    } else {
        # sinon effacement de la selection
        xtext_pushState
        xtext_delete $w -push 0  sel 
        xtext_markDirty $w
    }
    $w see insert
    xtext_updateInsertPos $w
}

## xtext_deleteLeftWord w - move back one word
# 
proc xtext_deleteLeftWord { w } {

    # si pas de selection dans le texte effacement du mot a gauche 
    # du curseur
    if { ![xtext_hasSel $w]} {
      
        if [$w compare insert != 1.0] {
            # sauvegarde de l'état si on n'est pas au debut du texte 
            xtext_pushState
            xtext_repeat $w {
                $w mark set del_to insert
                while {[$w compare insert != 1.0] &&
                       [string match "\[ \t\n\]" [$w get {insert - 1 char}]]} {
                  $w mark set insert {insert - 1 char}
                }
                while {[$w compare insert != 1.0] &&
                       ![string match "\[ \t\n\]" [$w get {insert - 1 char}]]} {
                  $w mark set insert {insert - 1 char}
                }
                $w delete insert del_to
                $w see insert
            }
            xtext_markDirty $w
        }
       
    } else {
        xtext_pushState
        xtext_delete $w -push 0  sel 
        xtext_markDirty $w
    }     
    xtext_updateInsertPos $w
}


## xtext_deleteRightWord w - move forward one word
# 
proc xtext_deleteRightWord { w } {

    # si pas de selection dans le texte effacement du mot a droite 
    # du curseur
    if { ![xtext_hasSel $w] } {
   
        if [$w compare insert != end] {  
    
            # sauvegarde de l'état si on n'est pas a la fin du texte
            xtext_pushState
            xtext_repeat $w {
                $w mark set del_from insert
                while {[$w compare insert != end] &&
                       [string match "\[ \t\n\]" [$w get insert]]} {
                  $w mark set insert {insert + 1 char}
                }
                while {[$w compare insert != end] &&
                       ![string match "\[ \t\n\]" [$w get insert]]} {
                  $w mark set insert {insert + 1 char}
                }
                $w delete del_from insert
                $w see insert
            }
            # marquage du widget "dirty"
            xtext_markDirty $w
        }
    } else {
        xtext_pushState
        xtext_delete $w -push 0  sel 
        xtext_markDirty $w
    }     
    xtext_updateInsertPos $w
}


## xtexte_killEndLine - supprime la fin de ligne
# 
proc xtext_killEndLine { w } {
    global xtext
  
    # si pas de selection dans le texte :
    # - effacement de la ligne sans le \n ou du \n tout seul si 
    #   pas de repeat_count
    # - si le repeat_count est >=2, effacement des n lignes (avec le \n)
    if {![xtext_hasSel $w]} {        
  
        # if no argument, DON'T kill "\n" unless it's only thing at insert
        if {$xtext($w,autoRepeatCount) < 2} {
      
            # in case it's eg -1
            xtext_autoRepeatClearCount $w
            if {[$w index insert] == [$w index {insert lineend}]}  {
                if [$w compare insert != end] {  
                    # sauvegarde de l'information de Undo 
                    # (si on n'est pas a la fin)
                    xtext_pushState
                    $w delete insert
                    xtext_markDirty $w
                }
            } else {
                # sauvegarde de l'information de Undo
                xtext_pushState
                $w delete insert {insert lineend}
                xtext_markDirty $w
            }
        
        } else {
            if {"[$w index insert]" != "end"} {
                xtext_pushState
                # with argument, kill that many lines (including "\n")
                xtext_autoRepeat $w {
                    $w delete insert {insert lineend + 1 char}
                }
                xtext_markDirty $w
            }
        }    
        set xtext($w,autoRepeatCount) 1
      
    } else {
        xtext_pushState
        xtext_delete $w -push 0  sel 
        xtext_markDirty $w
    }
    xtext_updateInsertPos $w    
}

## xtext_transpose --
# 
# This procedure implements the "transpose" function for text widgets.
# It tranposes the characters on either side of the insertion cursor,
# unless the cursor is at the end of the line.  In this case it
# transposes the two characters to the left of the cursor.  In either
# case, the cursor ends up to the right of the transposed characters.
#
# Arguments:
# w - Text window in which to transpose.
# 
proc xtext_transpose {w} {

    set pos insert
    if {[$w compare $pos != "$pos lineend"]} {
        set pos [$w index "$pos + 1 char"]
    }
    set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
    if {[$w compare "$pos - 1 char" == 1.0]} {
        return
    }

    xtext_pushState
    xtext_markDirty %W
    
    $w delete "$pos - 2 char" $pos
    $w insert insert $new
    $w see insert
    xtext_updateCursorSize $w

}


#f######################################################################
#f  5 - les commandes de recherche (find, findNextPara, findNextWord..)
#f######################################################################


## xtext_prevPara --
# 
# Returns the index of the beginning of the paragraph just before a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -    The text window in which the cursor is to move.
# pos -    Position at which to start search.
# 
# 31/07/01 (diam) A refondre en utilisant "Text search"
# 
proc xtext_prevPara {w pos} {
    set pos [$w index "$pos linestart"]
    while 1 {
        if {(([$w get "$pos - 1 line"] == "\n") 
                    && ([$w get $pos] != "\n"))
                        || ($pos == "1.0")} {
                        
            if {[regexp -indices {^[ \t]+(.)} \
                    [$w get $pos "$pos lineend"] \
                    dummy index]} {
                set pos [$w index "$pos + [lindex $index 0] chars"]
            }
            if {[$w compare $pos != insert] || ($pos == "1.0")} {
                return $pos
            }
        }
        set pos [$w index "$pos - 1 line"]
    }
}

## xtext_nextPara --
# 
# Returns the index of the beginning of the paragraph just after a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -    The text window in which the cursor is to move.
# start -  Position at which to start search.
# 
# 31/07/01 (diam) A refondre en utilisant "Text search"
# 
proc xtext_nextPara {w start} {
    set pos [$w index "$start linestart + 1 line"]
    while {[$w get $pos] != "\n"} {
        if {[$w compare $pos == end]} {
            return [$w index "end - 1c"]
        }
        set pos [$w index "$pos + 1 line"]
    }
    while {[$w get $pos] == "\n"} {
        set pos [$w index "$pos + 1 line"]
        if {[$w compare $pos == end]} {
            return [$w index "end - 1c"]
        }
    }
    if {[regexp -indices {^[ \t]+(.)} [$w get $pos "$pos lineend"] \
            dummy index]} {
        return [$w index "$pos + [lindex $index 0] chars"]
    }
    return $pos
}

## xtext_nextWord --
# Returns the index of the next word position after a given position in the
# text.  The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -    The text window in which the cursor is to move.
# start -  Position at which to start search.

if {$tcl_platform(platform) == "windows"}  {
    proc xtext_nextWord {w start} {
        xtext_nextPos $w [xtext_nextPos $w $start tcl_endOfWord] \
            tcl_startOfNextWord
    }
} else {
    proc xtext_nextWord {w start} {
        xtext_nextPos $w $start tcl_endOfWord
    }
}

## xtext_nextPos --
# 
# Returns the index of the next position after the given starting
# position in the text as computed by a specified function.
#
# Arguments:
# w -      The text window in which the cursor is to move.
# start -  Position at which to start search.
# op -     Function to use to find next position.
# 
# origine : libtk8.4/text.tcl (embedded windows and images)
# 
proc xtext_nextPos {w start op} {
    set text ""
    set cur $start
    while {[$w compare $cur < end]} {
        set text "$text[$w get $cur "$cur lineend + 1c"]"
        set pos [$op $text 0]
        if {$pos >= 0} {
            ## Adjust for embedded windows and images
            ## dump gives us 3 items per window/image
            set dump [$w dump -image -window $start "$start + $pos c"]
            if {[llength $dump]} {
                set pos [expr {$pos + ([llength $dump]/3)}]
            }
            return [$w index "$start + $pos c"]
        }
        set cur [$w index "$cur lineend +1c"]
    }
    return end
}

## xtext_prevPos --
# 
# Returns the index of the previous position before the given starting
# position in the text as computed by a specified function.
#
# Arguments:
# w -      The text window in which the cursor is to move.
# start -  Position at which to start search.
# op -     Function to use to find next position.
# 
# origine : libtk8.4/text.tcl (embedded windows and images)
# 
proc xtext_prevPos {w start op} {
    set text ""
    set cur $start
    while {[$w compare $cur > 0.0]} {
        set text [$w get "$cur linestart - 1c" $cur]$text
        set pos [$op $text end]
        if {$pos >= 0} {
            ## Adjust for embedded windows and images
            ## dump gives us 3 items per window/image
            set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
            if {[llength $dump]} {
                ## This is a hokey extra hack for control-arrow movement
                ## that should be in a while loop to be correct (hobbs)
                if {[$w compare [lindex $dump 2] > \
                        "$cur linestart - 1c + $pos c"]} {
                    incr pos -1
                }
                set pos [expr {$pos + ([llength $dump]/3)}]
            }
            return [$w index "$cur linestart - 1c + $pos c"]
        }
        set cur [$w index "$cur linestart - 1c"]
    }
    return 0.0
}

#f######################################################################
#f  6 - les commandes de déplacements  
#f######################################################################

## xtext_moveCursor -- déplace l'insert en fonction des options
# 
# Syntaxe :
# 
#   xtext_moveCursor $w ?options?
# 
# Une et une seule option de direction parmi les 6 autorisée est possible
# Toute autre combinaison entraine un comportement indéfini.
# 
# Options :
#   -up N
#   -down N : vers le haut ou vers le bas en tenant compte des lignes vide
#   -left N 
#   -right N : vers la gauche ou la droite sur la ***meme*** ligne
#   -backwards N
#   -forwards N : vers le début ou la fin du nombre de caractères indiqué
#             ce déplacement peut entrainer un changement de ligne.
#             
#   -nomove   (flag) : Si vrai, retourne le nouvel index sans aucun déplacement
#           Utile pour définir un nouvel insert pour dupliquer la sélection 
#           rectangulaire par exemple.
# 
# S'il existe une sélection le curseur est simplement déplacé au bord de
# la sélection, en fonction des options et du mode de sélection (rect ou non)
# Si xtext(selectMode) != rect :
# 
#  -up ou -left => positionnement en début de selection et déselection
#     -down ou -right => positionnement en fin de selection et déselection
#   
# Si xtext(selectMode) == rect :
#     -up ou -left => positionnement en début de selection et déselection
#     -down ou -right => positionnement en fin de le première ligne
#         selectionmée et déselection
#   
# BUG : 
#    La valeur de l'index retourné peut etre différente de celle
#    réellement affectée si on atteint la limite du texte
#    Par exemple si l'insert courant vaut 996.0, la commande :
#      xtext_moveCursor $w -l 1
#    retournera 996.-1 alors que le curseur restera en 996.0
#    Je corrigerai quand ce sera genant, ou quand j'aurai le temps (:-)
# 
# Exemples :
# 
#    set fromIdx [xtext_moveCursor $w -forwards -nomove]
#        Récupère l'index de "fin" de sélection (qui n'est pas "sel.end" si
#        cette sélection est rectangulaire !)
#     
proc xtext_moveCursor { w args  } {
    global xtext
    
    # Seules trois variable de direction sront définies :
    #       opt(-down), opt(-right) et opt(-forward)
    # Les trois autres options de direction change simplement le signe
    # 
    Parsarg_fullSpec opt {
        d -  
        down  {
            -default  0
            -type   integer
        }
        u -  
        up  {
            -variable  opt(-down)
            -type   integer
            -eval {set opt(-down) [expr {$opt(-down) * -1}]}
        }
        
        r - 
        right  {
            -default  0
            -type   integer
        }
        l -  
        left  {
            -variable  opt(-right)
            -type   integer
            -eval {set opt(-right) [expr {$opt(-right) * -1}]}
        }
        
        f -  
        forwards  {
            -default  0
            -type   integer
        }
        b -  
        backwards  {
            -variable  opt(-forwards)
            -type   integer
            -eval {set opt(-forwards) [expr {$opt(-forwards) * -1}]}
        }
        
        nomove   {
            -type  flag
            -label "Si vrai, retourne le nouvel index sans aucun déplacement"
        }
    }
    if {! ($opt(-down) || $opt(-right) || $opt(-forwards) )} {
        error "Manque l'option de direction (-up, -left, -backwards, ...)"
    }
    if {[xtext_hasSel $w]} {
    
        if {($opt(-down) < 0) || ($opt(-right) < 0) || ($opt(-forwards) < 0) } {
            # On veut aller vers le début du texte
            set newInsert [$w index sel.first]
        } else {
            # On veut aller vers la fin du texte
            if {[xtext_hasRectSel $w]} {
                set lineNum [xtext_getLineNum $w sel.first]
                set colNum  [xtext_getColNum  $w sel.last]
                set newInsert $lineNum.$colNum
            } else {
                set newInsert [$w index sel.last]
            }
        }
        
    } else {
    
        set insLineNum [xtext_getLineNum $w insert]
        set insColNum  [xtext_getColNum  $w insert]
        
        if {$opt(-down)} {
            set opt(-down) [expr {$opt(-down) * [xtext_autoRepeat $w -get]}]
            set newInsert [xtext_upDownLine $w  $opt(-down)]
                        
        } elseif {$opt(-right)} {
            set opt(-right) [expr {$opt(-right) * [xtext_autoRepeat $w -get]}]
            # attention : 
            #    la variable $opt(-right) peut valoir 2 ou -2 d'où le "1*$opt.."
            set newInsert $insLineNum.[expr {$insColNum + 1 * $opt(-right)}] 
           
        } elseif {$opt(-forwards)} {
            set opt(-forwards) \
                        [expr {$opt(-forwards)*[xtext_autoRepeat $w -get]}]
            if {$opt(-forwards) > 0} {
                set sign "+" 
            } else {
                set sign ""  ;# le signe "-" est dans la variable $opt(-forward)
            }
            set newInsert [$w index "insert $sign $opt(-forwards)c"] 
        }
    }
        
    if {!$opt(-nomove)} {
        xtext_unSelect $w
        xtext_setCursor $w $newInsert
    }
    return $newInsert
}


## xtext_upDownLine --
# 
# Returns the index of the character one line above or below the
# insertion cursor.  There are two tricky things here.  First,
# we want to maintain the original column across repeated operations,
# even though some lines that will get passed through don't have
# enough characters to cover the original column.  Second, don't
# try to scroll past the beginning or end of the text.
#
# Arguments:
# w -    The text window in which the cursor is to move.
# n -    The number of lines to move: -1 for up one line,
#        +1 for down one line.
# 
proc xtext_upDownLine {w n} {
    global xtext

    set i [$w index insert]
    scan $i "%d.%d" line char
    
    if {[string compare $xtext(prevPos) $i] != 0} {
        set xtext(char) $char
    }
    set new [$w index [expr {$line + $n}].$xtext(char)]
    if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
        set new $i
    }
    set xtext(prevPos) $new
    return $new
}

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

########################################################################
# Procédures permettant d'exécuter plusieurs fois le commande suivante
# Principe :
# 
# - chaque commande éventuellement répétable doit faire appel à 
#   xtext_autoRepeat (anciennement te:bindings:repeatable)
#   Cette procédure fait appel à une variable globale 
#   xtext($w,autoRepeatCount)
#   Pour savoir combien de fois la commande doit etre executée.
# 
# - un raccourci spécial (anciennement <Escape>), mais en prendre un autre
#   (voir ce que fait emacs à ce sujet) déclanche le comptage.
# 
# - L'utilisateur saisie un nombre de digit pour indiquer (en base 10) le 
#   nombre d'exécution à assurer.
# 
# - la première key qui n'est pas un chiffre sera la commande à exécuter
# 
# 
# Cette fonctionnalité devra etre (ré)implémentée en utilisant un bintag
# particulier ("autoRepeat") qui sera inséré un début des bintags du xtext
# lorseque on sera en mode de collection du nombre autoRepeatCount.
# puis tout ce qui n'est pas un chiffre déclanchera :
# - la suppression du bindtag
# - la réémission de autoRepeatCount le dernier raccourci intercepté
# 
# Question : 
#   comment gérer le UNDO pour ne faire qu'un seul checkpoint 
#   pour l'ensemble des autoRepeatCount action.
#   Solution prévoir les procédures :
#        xtext_undoDisable $w
#        xtext_undoEnable $w
# 
# Puis autre solution : utiliser la pile de undo
# 
#        xtext_macroStart $w
#        xtext_macroStop $w
# 

## xtext_autoRepeat -- gère la multievaluation automatique (bas niveau)
# 
# Syntaxe :
# 
#   xtext_autoRepeat ?option? tclCode
# 
# options :
# 
#  -get : retourne le nombre d'évaluation à réaliser et le remet à 1
#      Dans ce cas, le reste des arguments est ignoré.
# 
# Nota : 
# 
#    Cette commande doit rester de bas niveau, et ne peut pas etre appelée
#    dans un proc récursives
#    Voir également la future procédure xtext_repeat de plus haut niveau 
#    qui pourra éventuellement appeler xtext_autoRepeat
#    Mais elle pourra gérer le push, ...
#    
# # A FAIRE  : UTILISER xtext_repeat au lieu de xtext_autoRepeat partout
# 
proc xtext_autoRepeat { w args } {
 
    global xtext

    Parsarg_fullSpec  opt {
        get flag
    }
    
    if {$opt(-get)} {
        set N $xtext($w,autoRepeatCount)
        set xtext($w,autoRepeatCount)  1
        set xtext($w,autoRepeatActif)  0
        return $N
    }

    set tclCode [lindex $args 0]
    set N $xtext($w,autoRepeatCount)
        
    # On repositionne le prochain nombre d'évalution par défaut
    set xtext($w,autoRepeatCount) 1
    # On arrete de collecter les chiffres
    set xtext($w,autoRepeatActif) 0

    for {set i 0} {$i < $N} {incr i} {
         # evalution dans le contexte appelant
         uplevel 1 $tclCode
    }
}


## xtext_repeat -- execute un script une ou plusieurs fois (haut niveau)
# 
#       xtext_repeat $w ?keyValues?  n  body
# 
# options 
#  -n <integer> : nombre d'évaluation à réaliser
#      0 (par défaut) valeur automatique donnée par xtext($w,autoRepeatCount)
#      1..n : impose la valeur de xtext($w,autoRepeatCount)
# 
proc xtext_repeat { w args} {
    
    global xtext
    Parsarg_fullSpec  opt {
        p  -
        push        {
            -default  0
            -type   boolean
        }
        n  {
            -default  0
            -type   integer
            -label "Nombre de repétition : 0 pour automatique"
        }
    }
    
    set tclCode [lindex $args 0]
    
    if {$opt(-push)} {
        xtext_pushState
        xtext_markDirty $w
    } 
    

    if {$opt(-n) == 0} {
        # nombre d'insertions automatiques
        uplevel 1 [list xtext_autoRepeat $w $tclCode]
    } else {
        # nombre d'insertions explicites
        for {set i 0} {$i < $opt(-n)} {incr i} {
             # evalution dans le contexte appelant
             uplevel 1 $tclCode
        }
    }
}

## xtext_autoRepeatClearCount - clear argument count
# 
# 
proc xtext_autoRepeatClearCount {w} {
    global xtext
    set xtext($w,autoRepeatCount) 1
}

## xtext_autoRepeatTimes4Count - set repeat count to four, or multiply by four
# 
# 
proc xtext_autoRepeatTimes4Count {w} {
    global xtext
    
    if {$xtext($w,autoRepeatCount) < 1} {
        set xtext($w,autoRepeatCount) 1
    }
    set xtext($w,autoRepeatCount) [expr {$xtext($w,autoRepeatCount)*4}]
}

## xtext_autoRepeatStartCount w digit - start a numeric argument
#   invalid if not bound to (a sequence ending in) a digit key
# 
# A refaire en utilisant un bindtag "MultiEval"
# 
proc xtext_autoRepeatStartCount { w digit } {
    global xtext
    set xtext($w,autoRepeatActif) 1
    set xtext($w,autoRepeatCount) [expr "$digit"]
}


## xtext_autoRepeatAppendDigit -- continue la saisie du nombre
# 
# param: 
#   w : widget xtext
#   digit : un chiffre (sinon génère une erreur)
# 
proc xtext_autoRepeatAppendDigit { w digit } {
    global xtext
    set xtext($w,autoRepeatCount) \
            [expr {($xtext($w,autoRepeatCount)*10)+$digit}]
}

########################################################################
# Fin de procédure "autoRepeat"
########################################################################



## te:tb:e:set-mark-command w - set emacs mark at current insert point
# 
proc te:tb:e:set-mark-command { w } {
    $w mark set emacs_mark insert
    stead:log -title "Emacs Mark"  "has been set"
}

## te:tb:e:exchange-point-and-mark w - swap insert point and emacs mark
# 
proc te:tb:e:exchange-point-and-mark { w } {
    if {[lsearch [$w mark names] emacs_mark] != -1} {
        set mark [$w index emacs_mark]
        $w mark set emacs_mark insert
        $w mark set insert $mark
        $w see insert
        # deselectionne
        xtext_unSelect $w
        # affiche la position
        xtext_updateInsertPos $w      
        stead:log -title "Exchanging Insert Point and Emacs Mark"  "Done"
    } else {
        stead:log  "The emacs mark is not set in text"
    }
} 
    
## te:tb:go-to-mark - go to emacs mark without changing it
# 
proc te:tb:e:go-to-mark { w } {
  if {[lsearch [$w mark names] emacs_mark] != -1} {
    set mark [$w index emacs_mark]
    $w mark set insert $mark
    $w see insert
    # deselectionne
    xtext_unSelect $w
    # affiche la position
    xtext_updateInsertPos $w      
    stead:log -title "Go To Emacs Mark"  "Done"
  } else {
    stead:log  "The emacs mark is not set in text"
  }
}

## xtext_getFirstIndex -- retourne la premiere des deux marques A ou B
# 
# 
proc xtext_getFirstIndex {w  markA markB} {
    if {[$w compare $markA < $markB]} {
        return $markA
    } else {
        return $markB
    }
}

## xtext_getLastIndex -- retourne la dernière des deux marques A ou B
# 
proc xtext_getLastIndex {w  markA markB} {
    if {[$w compare $markA < $markB]} {
        return $markB
    } else {
        return $markA
    }
}


## xtext_getLineNum -- retourne le numéro de ligne de l'index
# 
# 
proc xtext_getLineNum {w  mark} {
    return [lindex [split [$w index $mark] .] 0]
}

## xtext_getColNum -- retourne le numéro de colonne de l'index
# 
# 
proc xtext_getColNum {w  mark} {
    return [lindex [split [$w index $mark] .] 1]
}

## xtext_getTopLineNum -- retourne l'indice de la ligne la plus haute
# 
# Retourne le  numéro de la ligne correspondant à la marque la plus  
# proche du début du fichier parmi markA et markB
# 
proc xtext_getTopLineNum {w  markA markB} {
    set lineIdxA [xtext_getLineNum $w $markA]
    set lineIdxB [xtext_getLineNum $w $markB]
    if {$lineIdxA < $lineIdxB} {return $lineIdxA} {return $lineIdxB}
}

## xtext_getBotLineNum -- retourne l'indice du la ligne la plus haute
##                          à renommer xtext_getBotLineNum
# 
# Retourne le  numéro de la ligne correspondant à la marque la plus  
# proche de la fin du fichier parmi markA et markB
# 
proc xtext_getBotLineNum {w  markA markB} {
    set lineIdxA [xtext_getLineNum $w $markA]
    set lineIdxB [xtext_getLineNum $w $markB]
    if {$lineIdxA > $lineIdxB} {return $lineIdxA} {return $lineIdxB}
}

## xtext_getLeftColNum -- retourne le numéro de la colonne la plus à gauche
# 
# Retourne le plus numéro de colonne correspondant à la marque la plus à 
# gauche parmi les marques markA et makB
# 
proc xtext_getLeftColNum {w  markA markB} {
    set colA [xtext_getColNum $w $markA]
    set colB [xtext_getColNum $w $markB]
    if {$colA < $colB} {return $colA} {return $colB}
}

## xtext_getRightColNum -- retourne le numéro de la colonne la plus à droite
# 
# Retourne le plus numéro de colonne correspondant à la marque la plus à 
# droite parmis les marques markA et makB
# 
proc xtext_getRightColNum {w  markA markB} {
    set colA [xtext_getColNum $w $markA]
    set colB [xtext_getColNum $w $markB]
    if {$colA > $colB} {return $colA} {return $colB}
}

## xtext_guessIndex  -- devine un numéro d'index valide à partir d'une chaine
# 
# return : un index deviné à partir de la chaine, ou la valeut spécifiée par 
#     défaut si impossible. 
# 
# string : la chaine de laquelle sera tirée l'index si possible
# default : valeur par défaut qui peut etre laissée vide pour faciliter la 
#     détection par la procédure appelante, ou imposer 
#     à une valeur raisonnable pour un contexte donné comme 1.0 ou end
# 
# param :
#   
#   string : une chaine représentant un index. peut etre une simple nombre
#       ou encore une chaine contenant un index ou un numéro de ligne
# 
# Exemples :
#   2.3    => 2.3
#   end    => 286.23  (par exemple)
#   7      =>  7.0
#   "Error line 47" => 47.0
# 
proc xtext_guessIndex {w string {defaultIdx ""}} {
    if { ![catch {$w index $string} result]} {
        # c'était un vrai index ou une marque existante
        return $result
    } elseif {[regexp -- {\d+\.\d+} $string indexString ]} {
        # "string" contient un index 
        return $indexString
    } elseif {[regexp -- {\d+} $string lineNumber ]} {
        # "string" contient un numéro de ligne
        return $lineNumber.0
    } else {
        # pas d'index trouvé : on pourra affiner la recherche en détectant
        # un nom de marque noyé dans le chaine par exemple
        return $defaultIdx
    }
}
# ./

