## regexp.tcl - gestion de substitutions et/ou de tests par expressions 
#              regulieres
# 
# Ce fichier contiend  diverses procedures traitant des regexp
# 
# TOUT CA SERA A VIRER ! (à terme)
# 

package provide stead 2.0

# Regexp_DefinePatternFromList -
# 
# retourne une liste patterne régulière en fonction d'une liste de mot 
# clés
#
proc Regexp_DefinePatternFromList {wordSepPat keylist} {

   return (^|${wordSepPat})([join $keylist |])(${wordSepPat}|$)
   
}

###############################################################################
# te:quoteExpr - permet d'analyser en expr reguliere certains caracteres
# speciaux (d'apres pete@cs.rice.edu <Pete Keleher>) 
###############################################################################

proc te:quote_expr str {
	regsub -all {\\} $str {\\\\} str
	regsub -all {\|} $str {\|} str
	regsub -all {\*} $str {\\*} str
	regsub -all {\+} $str {\\+} str
	regsub -all {\(} $str {\\(} str
	regsub -all {\)} $str {\\)} str
	regsub -all {\[} $str {\\[} str
	regsub -all {\]} $str {\\]} str
	return $str
}

# empeche l'interpretation des caracteres \ ] [ et $ par la commande eval

proc te:no_interp str {
  regsub -all {\\} $str {\\\\} str
  regsub -all {\[} $str {\\[} str
  regsub -all {\]} $str {\\]} str
  regsub -all {\$} $str {\\$} str
  regsub -all {\{} $str "\\\{" str
  regsub -all {\}} $str "\\\}" str
  return $str
}

proc te:quote_expr2 str {
	regsub -all {\\} $str {\\\\} str
	regsub -all {\|} $str {\|} str
	regsub -all {\*} $str {\\*} str
	regsub -all {\+} $str {\\+} str
	regsub -all {\(} $str {\\(} str
	regsub -all {\)} $str {\\)} str
	regsub -all {\{} $str "\\\{" str
	regsub -all {\}} $str "\\\}" str
	regsub -all {\[} $str {\\[} str
	regsub -all {\]} $str {\\]} str
	return $str
}

proc te:quote_expr3 str {
	regsub -all {\\} $str {\\\\} str
	regsub -all {\|} $str {\|} str
	regsub -all {\*} $str {\\*} str
	regsub -all {\+} $str {\\+} str
	regsub -all {\(} $str {\\(} str
	regsub -all {\)} $str {\\)} str
	regsub -all {\{} $str "\\\{" str
	regsub -all {\}} $str "\\\}" str
	regsub -all {\[} $str {\\[} str
	regsub -all {\]} $str {\\]} str
	regsub -all {\^} $str {\\^} str
        regsub -all {\$} $str {\\$} str
	return $str
}


################################################################################
# te:backslash_substitute - effectue les backslash substitutions speciales dans
# la chaine s 
# bug : comment rechercher un "\" ??
#        (tout ca sera a virer des qu'on pourra faire "subst" :-)
################################################################################

proc te:backslash_substitute {s {octal_sub 1}} {

  set return \n
  # La ligne suivante march mal (bug de regsub ?) : pour une suite de \n\n..
  # un \n sur deux est substutue par \x0a
  # if [regsub -all {(^\\n)|(([^\\])\\n)} $s \\3\n s1] {set s $s1}

  # substitution de l'ensemble des caracteres speciaux \...
  
  set search_string {(^\\a)|(([^\\])\\a)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\a" s
  }

  set search_string {(^\\b)|(([^\\])\\b)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\f" s
  }

  set search_string {(^\\f)|(([^\\])\\f)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\f" s
  }

  set search_string {(^\\n)|(([^\\])\\n)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\n" s
  }

  set search_string {(^\\r)|(([^\\])\\r)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\r" s
  }

  set search_string {(^\\t)|(([^\\])\\t)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\t" s
  }

  set search_string {(^\\v)|(([^\\])\\v)}
  while {[regexp $search_string $s e0 e1 e2 e3]} {
    regsub $search_string $s "$e3\v" s
  }
  
  # substitution des \ddd (valeurs octales) si $octal_sub vaut 1
  if {$octal_sub} {
    set search_string {(^\\([0-9][0-9]?[0-9]?))|(([^\\])\\([0-9][0-9]?[0-9]?))}
    while {[regexp $search_string $s a b c d e f]} {
      if {"x$c" != "x"} {
        scan $c %o h
      } else {
        scan $f %o h
      }
      regsub $search_string $s "$e[format %c $h]" s
    }
  }
  
  # substitution des \xhhh... (valeurs hexa)
  set search_string {(^\\x([0-9a-fA-F]+))|(([^\\])\\x([0-9a-fA-F]+))}  
  while {[regexp $search_string $s a b c d e f]} {  
    if {"x$c" != "x"} {
      scan $c %x h
    } else {
      scan $f %x h
    }
     regsub $search_string $s "$e[format %c $h]" s

  }
  return $s
}


################################################################################
# te:line_substitute - effectue les substitutions necessaires a la recherche 
# ligne par ligne
################################################################################

proc te:line_substitute {s {first 0} {last 0}} {

  if [regsub -all {\.} $s \[^\n\] s1] {set s $s1}
  if !$first {
    if [regsub {^\^} $s \n s1] {set s $s1}
  }
  if !$last {
    if [regsub {\$$} $s \n s1] {set s $s1}
  } 
  set search_string {(^\[\^)|(([^\\])\[\^)}
#  while {[regexp $search_string $s e0 e1 e2 e3]} {
#    regsub $search_string $s "$e3\[\^\n" s
#  }
  regsub -all {(^\[\^)|(([^\\])\[\^)} $s "\\3\[\^\n" s
  return $s
}

################################################################################
# te:begin_return - indique si un return est present au debut de la chaine
################################################################################

proc te:begin_return {s} {
  return [regexp "^\n" $s]
}

################################################################################
# te:end_return - indique si un return est present a la fin de la chaine
################################################################################

proc te:end_return {s} {
  return [regexp "\n$" $s]
}

proc te:no_ss_sub {s} {

  regsub -all {&} $s {\\&} s
  regsub -all {\\[0-9]+} $s {\\&} s
  return $s
}
