#### macro.tcl - macros pour l'editeurs stead 
# 
# Ces procédure ne doivent PAS etre utilisées dans l'éditeur stead
# Elle sont réservée à l'utilisateur.
# Ces macro sont en général des sur couche à des procédures du widget
# xtext.
# Pour la doc de ces macros : voyez les procédure de la forme xtext_xxx.
# 
# historique :
#  30/11/99 (diam) : ???
#  27/07/01 (diam) : déplacement macros de gestion d'accents vers chars.tcl
#  07/08/02 (diam) : nouvelle macro "aa" 
# 
###########################################################################

package provide stead 2.0

## ins  insère une chaine de caractères dans stead en gérant de Undo 
# 
# exemple d'utilisation :
#  ins "popo\tpipi\n" 5 "end -10 c"
#    insere 5 lignes "popo	pipi" a 10 caractere avant la fin du fichier
#  ins $VAR
#    insere le contenu de la var=iable VAR au point d'insertion courant
# 
proc ins { args } {
    upvar #0 stead(text) w
    uplevel xtext_insert $w $args
}


## del  macro de suppression de texte (surcouche à xtext_delete)
# 
# Exemples :
#   del sel
#   del -ranges $rangeSpec
#   del -tags $tags
#   del  $tagsOrRange
#   del  sel 327.4 "end-7l+3c" commentTag
# 
# 
proc del args {
    upvar #0 stead(text) w
    uplevel xtext_delete $w $args
}

## sel  macro de sélection/déselection (surcouche à xtext_select)
# 
# Exemples :
#   sel -line
#   sel -word
#   sel -char
#   sel -all 
#   sel -rem 
#   sel 1.5 10.3
#   sel -rect 706.21 712.47
#   sel -rect  712.47 706.21  => bug pas de sélection (à corriger)
#   
proc sel args {
    upvar #0 stead(text) w
    uplevel xtext_select $w $args
}
## see  alias pour stead:see 
# 
proc see args {
    uplevel stead:see $args
}
## go  alias pour stead:see avec dééplacement du curseur 
# 
proc go args {
    uplevel stead:see -setinsert $args
}

## ra  alias pour xtext_replaceAll
# 
# A METTRE AU POINT AVANT INTEGRATION DANS FIND/REPLACE STANDARD
# FAIRE EGALEMENT REPLACE_SELECTION (alias rs)
# exemple d'appel : ra \n \r\n
# exemple d'appel : ra \r ""
# 
# # proc ra {args} {
# #    eval uplevel xtext_replaceAll [list $args]
# # }
proc ra {args} {
    upvar #0 stead(text) w
    uplevel xtext_replaceAll $w  $args
}

## rs  alias pour xtext_replaceInSel
# 
# exemple d'appel : rs \n \r\n
# exemple d'appel : rs \r ""
# 
proc rs {args} {
    upvar #0 stead(text) w
    uplevel xtext_replaceInSel $w  $args
}


## aa  apply a Proc filter on all text
# 
# exemple d'appel : aa string_untabify 
# 
proc aa {args} {
    upvar #0 stead(text) w
    uplevel xtext_applyToAll  $w  $args
}

## as  apply a Proc filter on selected text
# 
# exemple d'appel : 
#       aa string_untabify 
# 
proc as {args} {
    upvar #0 stead(text) w
    uplevel xtext_applyToSel  $w  $args
}

## ta  transcode all text
# 
# exemple d'appel : 
#       ta utf82iso 
# 
proc ta {args} {
    upvar #0 stead(text) w
    uplevel xtext_transcodeAll  $w  $args
}

## ts  transcode all text
# 
proc ts {args} {
    upvar #0 stead(text) w
    uplevel xtext_transcodeSel  $w  $args
}

## style  gère les style du document courant
# 
# exemple d'appel : 
#       style applay tcl comment 
# 
proc style {args} {
    upvar #0 stead(text) w
    uplevel xtext_style  $w  $args
}


## quit  alias pour stead:quitBox
# 
# utile pour lancer lancer stead sur un script et quitter aussitot
# 
# Exemple : 
# 
#   stead  -command "Viewurl_Selected; quit" &
# 
proc quit {args} {
   uplevel stead:quitBox $args
}

########################################################################
## te:macro0 à te:macro9 -- Insertion de lignes de séparation
# 
# Procédures te:macro[0-9] liées aux raccourcis-clavier <Meta-1> à 
# <Meta-9> : Insertion de lignes de séparation
# 
proc te:macro1 {} {separator} ;# dépend du mode

proc te:macro2 {} {insert_fill_lines "!"}

proc te:macro3 {} {insert_fill_lines "#"}

proc te:macro4 {} {insert_fill_lines "-"}

proc te:macro5 {} {insert_fill_lines "%"}

proc te:macro6 {} {insert_fill_lines "^"}

proc te:macro7 {} {insert_fill_lines "/"}

proc te:macro8 {} {insert_fill_lines "\\"}

proc te:macro9 {} {insert_fill_lines "_"}

proc te:macro0 {} {
    stead:log -title "Macro 0"  "not defined" 
}


## c2i -- convertion d'un caractère en entier
# 
proc c2i c {
    scan $c "%c" myInteger 
    set myInteger
}
## c2i -- convertion d'un caractère en hexa
# 
proc c2h c {
    scan $c "%c" myInteger 
    set myHexaInteger [format {%x} $myInteger]
}
## i2c -- convertion d'un décimal en caractère
# 
proc i2c i {
    format %c $i
}


## proc cdf -  fait un cd dans le répertoire du fichier édité
# 
# positionne l'interpréteur de stead dans le répertoire du fichier editer
# (utile quand on veut editer un autre fichier du même répertoire)
# 
# 03/11/99 (diam@ensta.fr)
# 
proc cdf {{dir ""}} {
   global     FILENAME 

   if {"x$dir" == "x"} {
    set dir [file dirname $FILENAME]
   }
   uplevel #0 set tcl_interactive 1
   uplevel #0 cd $dir

} ;# endproc separator


## num_a_faire -- numérotation du fichier "a-faire" : 
# 
# toute ligne commencant par un chiffre est renumerotée
#
proc num_a_faire {} {
  set i 1
  set text [.main.t get 1.0 end]
  while {[regsub "\n\[0-9,.\]+\[ \-\]*" $text "\n-$i \- " text]} {
    update
    incr i
  }
  regsub -all \n- $text \n text
  .main.t delete 1.0 end
  .main.t insert insert $text
}

## set_to_bin -- conversion en binaire
# 
proc set_to_bin { t } {
  set chars [$t get 1.0 end]
  if {"x$chars" != "x"} {
    xtext_pushState
    $t delete 1.0 end
    set n_octet 0
    split $chars
    for {set i 0} {$i < [string length $chars]} {incr i} {
      set c [string index $chars $i] 
      incr n_octet
      # on saute une ligne tous les 16 octets
      if {$n_octet > 16} {
        $t delete "insert -1 chars"
        $t insert insert \n
        set n_octet 1  
      }
      # conversion de chaque caractère en octet (hexa) et insertion
      scan $c "%c" oct
      set oct [format "%x" $oct]
      # on rajoute un 0 si un seul chiffre hexa
      if {[string length $oct] == 1} {set oct "0$oct"}
      # insersion d'un espace pour faciliter la lecture
      $t insert insert $oct
      $t insert insert " "
    }
    xtext_markDirty $t
  }
}    

###########################################################################
# set_to_char - convertit un fichier binaire en fichier ascii
###########################################################################


proc set_to_char { t } {

  set bytes [$t get 1.0 end]
  if {"x$bytes" != "x"} {
    xtext_pushState
    $t delete 1.0 end
    # on enlève les retours chariots, les espaces et tabulations
    # nécessaires à la présentation
    puts $bytes
    for {set i 0} {$i < [string length $bytes]} {incr i 3} {
     scan "[string range $bytes $i [expr $i+1]]" "%x" d
     $t insert insert [format "%c" $d] 
    }
    xtext_markDirty $t
  }       
}

# ###########################################################################
# NE PAS UTILISER TANT QUE rm == text roman des jtools...
# # rm files : detruit les fiers files 
# # (sans meta caracteres pour l'instant (sécurité))
# ###########################################################################
# proc rm {args} {
#     eval exec rm $args
# } ;#endproc rm


## print_help_files -- imprime les fichiers d'aides sur mure
# 
# 
proc print_help_files {} {
    set n 1
    set old_dir [pwd]
    cd $stead(install)/help
    foreach f [lsort [glob *.help]] {
      if [catch {exec a2ps -8 $f | lp -dmure} msg] {
        stead:log  "$n files"
        update
        incr n
      }
    } 

    proc print_tcllib_files {} {
      set n 1
      set old_dir [pwd]
      cd $stead(install)/help
      foreach f [lsort [glob *.help]] {
        if [catch {exec a2ps -8 $f | lp -dmure} msg] {
          stead:log "$n files"
          update
          incr n
        }
      } 
    }

}
## pc - retourne le poucentages d'écart entre les deux flottant en parametre
# 
# 
proc pc {f1 f2} {
    if {$f1 > $f2} {
        set tmp $f2
        set $f2 $f1
        set $f1 $tmp
    }
    return [expr 100*($f2-$f1)/$f1]
}


########################################################################
##  @htmlKeysToMin --  Exemple illustrant la gestion du undo en 
#           évitant les checkout intermédiaire dans une macro :
# 
# 
# Modifie la sélection de morceau HTML en convertissant en minuscule 
# certains tag HTML
proc @htmlKeysToMin {} {
    
    # On commence par faire un checkpoint (mémoriser le texte pour pouvoir
    # annuler)
    xtext_pushState
    
    # on inhibe undo :
    xtext_setPushStateActif 0
    
    set keys {
        H1 h1  H2 h2   H3 h3   H4 h4   H5 h5   H6 h6   H7 h7
        UL ul  OL ol   DL dl   LI li   DT dt 
        A  a   IMG img  SPAN span  DIV div BODY body 
        BR br  P p 
    }
    # remplacement de "</POPO " par "</popo "
    foreach  {key KEY}  $keys {
        rs -r "<(/)?${key}(\[^-_a-zA-Z0-9\])" "<\\1${KEY}\\2"

    }
    
    set attributes {
        HREF href   SRC src
    }
    # remplacement de "</img  xxx SRC =" par "</img  xxx src="
    #  <(\[>\]+)SRC *= *(\[>\]+)    <\\1src=\\2
    foreach  {ATTRIB attrib}  $attributes {
        rs -r "<(\[^>\]+)${ATTRIB} *= *(\[^>\]+)" "<\\1${attrib}=\\2"
    }
    
    # On revalide le undo
    xtext_setPushStateActif 1

}
# ./
