#
#f prefix.tcl : gestion des prefixes ET de l'indentation
#f 
#f A refondre en créant **une** procédure du style :
#    
#    xtext_indent ?option? N
#    
#    Indente la sélection de N unité d'indentation 
#    
#       -right (flag)
#       -left (flag) : direction d'indentation
#       -string <indentString>  : chaine d'indentation.
#           peut etre un seul espace, ou une chaine argitraire
#           par défaut, c'est EDITPREF(indentString)
# 



package provide stead 2.0

## te:add_prefix - renvoie une chaine précédé d'un prefixe pour chaque ligne
#
# modif diam 28/10/98 : utilisation de switch pour test de where
# modif diam 16/10/98 : pour l'indent apres prefixe de la premiere ligne
#                       plutot que apres prefixe de chaque ligne
# 
# A FAIRE : deux proc (une dans xtext et une dans string)
# 
#   xtext_insertPrefix w ?options? string
#         -afterindent (flag)
#   string_insertPrefix ?options? string
#   
proc te:add_prefix {p s {where before}} {
   set ret [regexp "\n$" $s]

   switch -- $where {
     "before" {
         regsub "^" $s &$p s
         regsub -all "\n" $s &$p s
     }
     "after" {
         # recuperer la premiere indent
         set firstIndent ""
         regexp "^\[ \t\]*" $s firstIndent
         # remplacer toute occurence des premiere indent par indent + prefix
         regsub      "$firstIndent" $s &$p s
         regsub -all "\n$firstIndent" $s &$p s
     }
     default {
         error "te:add_prefix where=$where au lieu de after ou beforë
     }
   }

   set p [te:quote_expr $p]
   if $ret {regsub "\n$p$" $s \n s}
   return $s

}



##  te:remove_prefix - enleve le  prefixe $p de la chaine $s
#
proc te:remove_prefix {p s} {
   regsub "(^\[ \t\]*)($p)" $s \\1 s
   regsub -all "(\n\[ \t\]*)($p)" $s \\1 s
   return $s
}

## te:remove_spaces -- enleve les espaces $sp au debut de la chaine $s ...
#
#  et apres chaque \n contenu dans s (enleve aussi les espaces si il y en a
#  moins que dans $sp
#
proc te:remove_spaces {sp s} {
   set spi $sp
   while {![regsub "(^ *)($spi)" $s \\1 s]} {
     if ![regsub " " $spi {} spi]  {break}
   }
   set spi $sp
   while {![regsub -all "(\n *)($spi)" $s \\1 s]} {
     if ![regsub " " $spi {} spi]  {break}
   }
   return $s
}

## te:cmd:ins_pref -- insere $EDITPREFS(prefix) après ou avant l'indentation
#

proc te:cmd:ins_pref {{where before}} {
     global stead
     
     upvar #0 stead(text) w
    
     # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
     xtext_select $w -line
    
     global EDITPREFS
     set sel [xtext_getSel $w]
     xtext_pushState $w

     if {[xtext_hasSel $w]} {
          xtext_select $w -line
          # .main.t tag add sel "sel.first linestart" \
          #                     "sel.last -1 chars lineend + 1 chars"
          set txt [xtext_getSel $w]
          set pos1 [$w index sel.first]
          $w delete sel.first sel.last
          $w insert insert [te:add_prefix $EDITPREFS(prefix) $txt $where]
          $w tag add sel $pos1 insert

     } else {

         set posBak [$w index insert]
         set txt [$w get "insert linestart" "insert lineend"]
         $w delete "insert linestart" "insert lineend"
         $w insert insert [te:add_prefix $EDITPREFS(prefix) $txt $where]
         $w mark set insert "$posBak + [string length $EDITPREFS(prefix)]c"
     }

     xtext_markDirty $w
}

## te:cmd:remove_prefix -- efface le prefixe $EDITPREFS(prefix)
#
# 28/10/98 (diam) rajout traitement si pas de sélection
#
proc te:cmd:remove_prefix {} {
  global stead
  global EDITPREFS

  upvar #0 stead(text) w

  # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
  xtext_select $w -line

  set sel [xtext_getSel $w]
  xtext_pushState $w

  if {("x$sel" != "x") && ("x[selection own]" == "x.main.t")} {
    .main.t tag add sel "sel.first linestart" \
                        "sel.last -1 chars lineend + 1 chars"
     set sel [xtext_getSel $w]
    .main.t delete sel.first sel.last
    set pos1 [.main.t index insert]
    .main.t insert insert [te:remove_prefix \
    [te:quote_expr $EDITPREFS(prefix)] $sel]
    .main.t tag add sel $pos1 insert
  } else {
    set posBak [.main.t index insert]
    set txt [.main.t get "insert linestart" "insert lineend"]
    .main.t delete "insert linestart" "insert lineend"

    .main.t insert insert [te:remove_prefix \
        [te:quote_expr $EDITPREFS(prefix)] $txt]
    .main.t mark set insert "$posBak - [string length $EDITPREFS(prefix)]c"
  }

  xtext_markDirty .main.t
}


## te:cmd:set_prefix - met a jour la variable EDITPREFS(prefix)
#
proc te:cmd:set_prefix {} {
   global stead
   global EDITPREFS
   set prompt_result [te:prompt -text "Enter New Prefix" \
   -default $EDITPREFS(prefix) -title "Set Prefix"]
   if {"x$prompt_result" != "x"} {
     set EDITPREFS(prefix) $prompt_result
     te:save_prefs
   }
}


## te:cmd:set_indent_spaces - met a jour la variable EDITPREFS(indent_string)
#
proc te:cmd:set_indent_spaces {} {
  global stead
  global EDITPREFS
  set prompt_result [te:prompt -text "Enter New Spaces String" \
  -default $EDITPREFS(indent_string) -title "Set Indent Spaces"]
    set EDITPREFS(indent_string) $prompt_result
  te:save_prefs
}


## te:spaces_string - renvoie une chaine composee de n espaces
#
proc te:spaces_string {n} {
  if {$n==0} {return ""}
  for {set i 1} {$i<=$n} {incr i} {
     append spaces_string " "
  }
  return $spaces_string
}



## te:remove_tab - enleve une tabulation au debut de chaque ligne de la
# chaine s
#
proc te:remove_tab {s} {
  regsub "(^)(\t)" $s \\1 s
  regsub -all "(\n)(\t)" $s \\1 s
  return $s
}

## te:cmd:indent_right - ajoute la chaine d'indentation
#
# $EDITPREFS(indent_spaces) a chaque ligne de la selection si elle existe,
# au debut de la ligne sinon
#
proc te:cmd:indent_right {} {
  global stead
  global EDITPREFS
  
  upvar #0 stead(text) w

  # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
  xtext_select $w -line

  set sel [xtext_getSel $w]

  # Cas ou la selection est dans le texte
  if {("x$sel" != "x") && ("x[selection own]" == "x.main.t")} {

    # si la selection trop longue : on refuse de traiter  !
    if {[expr [.main.t index sel.last]-[.main.t index sel.first]]
            > $stead(maxIndentNumber)} {
       stead:log "Can't indent : selection is too big !"
       return
    }
    # sauvegarde du contenu et de l'etat du fichier
    xtext_pushState $w
    # extension de la selection au debut et a la fin des lignes
    .main.t tag add sel "sel.first linestart" \
                        "sel.last -1 chars lineend + 1 chars"
    set sel [xtext_getSel $w]
    set pos1 [.main.t index sel.first]
    .main.t delete sel.first sel.last
    if [string match *\t* $EDITPREFS(indent_string)] {
      .main.t insert $pos1 [te:add_prefix \t $sel]
    } else {
      .main.t insert $pos1 [te:add_prefix \
      $EDITPREFS(indent_string)  [string_untabify $sel]]
    }
    .main.t tag add sel $pos1 insert
  } else {
    xtext_pushState $w
    if [string match *\t* $EDITPREFS(indent_string)] {
      .main.t insert "insert linestart" \t
      xtext_markDirty .main.t
    } else {
      set pos1 [.main.t index "insert linestart"]
      set pos2 [.main.t index "insert lineend"]
      set sel [.main.t get $pos1 $pos2]
      xtext_pushState $w
      # sauvegarde de la position du point d'insertion
      set old_insert [.main.t index insert]
      .main.t delete $pos1 $pos2
      .main.t insert $pos1 [string_untabify $sel]
      # restauration de la position du point d'insertion
      .main.t mark set insert $old_insert
      .main.t insert "insert linestart" \
      $EDITPREFS(indent_string)
    }
  }
}

## te:cmd:indent_one_space right - ajoute un espace
# a chaque ligne de la selection si elle existe, au debut de la ligne sinon
#
#
proc te:cmd:indent_one_space_right {} {
  global stead
  
  upvar #0 stead(text) w

  # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
  xtext_select $w -line

  set sel [xtext_getSel $w]
  if {("x$sel" != "x") && ("x[selection own]" == "x.main.t")} {
    if {[expr [.main.t index sel.last]-[.main.t index sel.first]]
            > $stead(maxIndentNumber)} {
       stead:log "Can't indent : selection is too big !"
       return
    }
    xtext_pushState $w
    .main.t tag add sel "sel.first linestart" \
                        "sel.last -1 chars lineend + 1 chars"
    set sel [xtext_getSel $w]
    set pos1 [.main.t index sel.first]
    .main.t delete sel.first sel.last
    .main.t insert $pos1 [te:add_prefix " "  [string_untabify $sel]]
    .main.t tag add sel $pos1 insert
  } else {
    set pos1 [.main.t index "insert linestart"]
    set pos2 [.main.t index "insert lineend"]
    set sel [.main.t get $pos1 $pos2]
    xtext_pushState $w
    # sauvegarde de la position du point d'insertion
    set old_insert [.main.t index insert]
    .main.t delete $pos1 $pos2
    .main.t insert $pos1 [string_untabify $sel]
    # restauration de la position du point d'insertion
    .main.t mark set insert $old_insert
    .main.t insert "insert linestart" " "
  }
}


## te:cmd:indent_left - enleve des espaces (nombre $EDITPREFS(indent_spaces)
# ou une tabulation (Si $EDITPREFS(indent_with_spaces)
# a chaque ligne de la selection si elle existe, au point d'insertion sinon
#
proc te:cmd:indent_left {} {
  global stead
  global EDITPREFS

  upvar #0 stead(text) w

  # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
  xtext_select $w -line

  set sel [xtext_getSel $w]
  set sp_str [string_untabify $EDITPREFS(indent_string)]
  if {("x$sel" != "x") && ("x[selection own]" == "x.main.t")} {
     if {[expr [.main.t index sel.last]-[.main.t index sel.first]]
            > $stead(maxIndentNumber)} {
       stead:log  "Can't indent : selection is too big !"
       return
     }
    xtext_pushState $w
    .main.t tag add sel "sel.first linestart" \
                        "sel.last -1 chars lineend + 1 chars"
    set sel [xtext_getSel $w]
    set pos1 [.main.t index sel.first]
    .main.t delete sel.first sel.last
    .main.t insert $pos1 [te:remove_spaces $sp_str [string_untabify $sel]]
    .main.t tag add sel $pos1 insert
  } else {
    set pos1 [.main.t index "insert linestart"]
    set pos2 [.main.t index "insert lineend"]
    set sel [.main.t get $pos1 $pos2]
    xtext_pushState $w
    # calcul de l'ancienne position en x du point d'insertion
    set y [lindex [split [.main.t index insert] .] 0]
    set x [lindex [split [.main.t index insert] .] 1]
    # on efface la sélection
    .main.t delete $pos1 $pos2
    # calcul de la chaine dé-indentée
    set new_string [te:remove_spaces $sp_str [string_untabify $sel]]
    # insertion de la nouvelle chaine
    .main.t insert $pos1 $new_string
    # calcul de la nouvelle position du point d'insertion
    set xn [expr $x - [string length $sel] + [string length $new_string]]
    # si on reste sur la même ligne, on positionne le point d'insertion
    if {$xn >= 0} {
      .main.t mark set insert $y.$xn
    } else {
      .main.t mark set insert $y.$x
    }
  }
}


## te:cmd:indent_one_space left -- enleve un espace (ou une tabulation)
# a chaque ligne de la selection si elle existe, au point d'insertion sinon
#
proc te:cmd:indent_one_space_left {} {
  global stead
  
  upvar #0 stead(text) w

  # On s'assure qu'il y a une sélection et qu'elle est en mode ligen
  xtext_select $w -line

  set sel [xtext_getSel $w]
  if {("x$sel" != "x") && ("x[selection own]" == "x.main.t")} {
     if {[expr [.main.t index sel.last]-[.main.t index sel.first]]
            > $stead(maxIndentNumber)} {
       stead:log  "Can't indent : selection is too big !"
       return
     }
     xtext_pushState $w
     .main.t tag add sel "sel.first linestart" \
                         "sel.last -1 chars lineend + 1 chars"
     set sel [xtext_getSel $w]
     set pos1 [.main.t index sel.first]
     .main.t delete sel.first sel.last
     .main.t insert $pos1 [te:remove_spaces " " [string_untabify $sel]]
     .main.t tag add sel $pos1 insert
  } else {
     set pos1 [.main.t index "insert linestart"]
     set pos2 [.main.t index "insert lineend"]
     set sel [.main.t get $pos1 $pos2]
     xtext_pushState $w
     .main.t delete $pos1 $pos2
     .main.t insert $pos1 [te:remove_spaces " " [string_untabify $sel]]
  }
}
# ./
