Mise en forme de code: pensez à utiliser les balises [ tcl ] et [ /tcl ] (sans les espaces bien sûr) autour de vos codes tcl afin d'avoir un meilleur rendu et une coloration syntaxique. x


Découper une ligne trop longue en plusieurs lignes
#1
Je propose 3 procédures différentes car j'utilise l'une ou l'autre selon les besoins.

Code :
Syntaxe : split_line <texte à formater> [limite]
Notez que {limit 435} rend l'argument limit optionnel et qu'il prendra 435 comme valeur par défaut s'il est omis.



1ère méthode
Découpage d'une ligne trop longue en plusieurs lignes en essayant de couper sur les espaces autant que possible.
Les \n provoquent un retour à la ligne.

Procédure
tcl
###############################################################################
### Découpage d'une ligne trop longue en plusieurs lignes en essayant de couper
### sur les espaces autant que possible.
### Les \n provoquent un retour à la ligne.
###############################################################################
proc split_line {data {limit 435}} {
incr limit -1
set data [string trim $data]
set data_length [string bytelength $data]
if { $data_length <= $limit } {
return [lsearch -all -inline -not -regexp [split $data "\n"] {^(\s+)?$}]
} else {
set cursor 0
# Note : si l'espace le plus proche est situé à plus de 50% de la fin du
# fragment, on n'hésite pas à couper au milieu d'un mot.
set middle_pos [expr {round($limit / 2.0)}]
while { $cursor < $data_length } {
if {
([set cut_index [string first "\n" $data $cursor]] != -1)
&& ($cut_index <= $cursor + $limit)
} then {
# on ne fait rien de plus, on vient de définir $cut_index
} elseif {
([set cut_index [string last " " $data [expr {$cursor + $limit + 1}]]] == -1)
|| ($cut_index <= $cursor)
|| ($data_length - $cursor < $limit)
|| ($cut_index - $cursor < $middle_pos)
} then {
set cut_index [expr {$cursor + $limit}]
}
lappend output [string trimright [string range $data $cursor $cut_index]]
set cursor [expr {$cut_index + 1}]
}
return [lsearch -all -inline -not -regexp $output {^(\s+)?$}]
}
}



2ème méthode
Découpage d'une ligne trop longue en plusieurs lignes en essayant de couper sur les espaces autant que possible.
Si l'espace le plus proche est à plus de 50% de la fin de la ligne, on s'autorise à couper au milieu d'un mot.
Les \n provoquent un retour forcé à la ligne et les styles (couleurs, gras, ...) sont préservés d'une ligne à l'autre.
$limit doit impérativement être >= 9
Une limitation connue empêche le découpage correct dans certaines conditions; ajouter un espace à la fin de la ligne à découper permet de contourner le problème. Remerciements à ealexp pour la fonction de préservation des styles.

Procédure
tcl
##############################################################################
### Découpage d'une ligne trop longue en plusieurs lignes en essayant de couper
### sur les espaces autant que possible. Si l'espace le plus proche est à plus
### de 50% de la fin de la ligne, on s'autorise à couper au milieu d'un mot.
### Les \n provoquent un retour forcé à la ligne et les styles (couleurs, gras,
### ...) sont préservés d'une ligne à l'autre.
### $limit doit être >= 9
### Remerciements à ealexp pour la fonction de préservation des styles.
##############################################################################
proc split_line {data {limit 435}} {
incr limit -1
if {$limit < 9} {
error "limit must be higher than 9"
}
if { [string bytelength $data] <= $limit } {
return [expr {$data eq "" ? [list ""] : [split $data "\n"]}]
} else {
# Note : si l'espace le plus proche est situé à plus de 50% de la fin du
# fragment, on n'hésite pas à couper au milieu d'un mot.
set middle_pos [expr round($limit / 2.0)]
set output ""
while {1} {
if { ([set cut_index [string first "\n" $data]] != -1) && ($cut_index <= $limit)} then {
# On ne fait rien de plus, on vient de définir $cut_index.
} elseif {
([set cut_index [string last " " $data [expr {$limit + 1}]]] == -1)
|| ($cut_index < $middle_pos)
} then {
set new_cut_index -1
# On vérifie qu'on ne va pas couper dans la définition d'une couleur.
for {set i 0} {$i < 6} {incr i} {
if {
([string index $data [set test_cut_index [expr {$limit - $i}]]] eq "\003")
&& ([regexp {^\003([0-9]{1,2}(,[0-9]{1,2})?)} [string range $data $test_cut_index end]])
} then {
set new_cut_index [expr {$test_cut_index - 1}]
}
}
set cut_index [expr {($new_cut_index == -1) ? ($limit) : ($new_cut_index)}]
}
set new_part [string range $data 0 $cut_index]
set data [string range $data $cut_index+1 end]
if { [string trim [string map [list \002 {} \037 {} \026 {} \017 {}] [regsub -all {\003([0-9]{0,2}(,[0-9]{0,2})?)?} $new_part {}]]] ne "" } {
lappend output [string trimright $new_part]
} 
# Si, quand on enlève les espaces et les codes de formatage, il ne reste
# plus rien, pas la peine de continuer.
if { [string trim [string map [list \002 {} \037 {} \026 {} \017 {}] [regsub -all {\003([0-9]{0,2}(,[0-9]{0,2})?)?} $data {}]]] eq "" } {
break
}
set taglist [regexp -all -inline {\002|\003(?:[0-9]{0,2}(?:,[0-9]{0,2})?)?|\037|\026|\017} $new_part]
# Etat des tags "au repos"; les -1 signifient que la couleur est celle par
# défaut.
set bold 0 ; set underline 0 ; set italic 0 ; set foreground_color "-1" ; set background_color "-1" 
foreach tag $taglist {
if {$tag eq ""} {
continue
}
switch -- $tag {
"\002" { if { !$bold } { set bold 1 } { set bold 0 } }
"\037" { if { !$underline } { set underline 1 } { set underline 0 } }
"\026" { if { !$italic } { set italic 1 } { set italic 0 } }
"\017" { set bold 0 ; set underline 0 ; set italic 0 ; set foreground_color "-1" ; set background_color "-1" }
default {
lassign [split [regsub {\003([0-9]{0,2}(,[0-9]{0,2})?)?} $tag {\1}] ","] foreground_color background_color
if {$foreground_color eq ""} {
set foreground_color -1 ; set background_color -1
} elseif {($foreground_color < 10) && ([string index $foreground_color 0] ne "0")} {
set foreground_color 0$foreground_color
}
if {$background_color eq ""} {
set background_color -1
} elseif {
($background_color < 10)
&& ([string index $background_color 0] ne "0")
} then {
set background_color 0$background_color
}
}
}
}
set line_start ""
if {$bold} { append line_start \002 }
if {$underline} { append line_start \037 }
if {$italic} { append line_start \026 }
if {($foreground_color != -1) && ($background_color == -1)} { append line_start \003$foreground_color }
if {($foreground_color != -1) && ($background_color != -1)} { append line_start \003$foreground_color,$background_color }
set data ${line_start}${data}
}
return $output
}
}



3ème méthode
Découpage d'un texte trop long en plusieurs fragments.
Le découpage peut intervenir au milieu d'un mot et les \n sont compris comme une fin de fragment.
La limite ne doit pas être inférieure à 2.

Procédure
tcl
###############################################################################
### Découpage d'un texte trop long en plusieurs fragments.
### Le découpage peut intervenir au milieu d'un mot et les \n sont compris comme
### une fin de fragment.
### La limite ne doit pas être inférieure à 2.
###############################################################################
proc split_line {data {limit 435}} {
incr limit -1
set output_length [string bytelength $data]
set letter_index 0
while {$letter_index < $output_length} {
if {
([set CRLF_index [string first "\n" $data $letter_index]] <= [set range_end [expr {$letter_index + $limit}]])
&& ($CRLF_index > -1)
} then {
set cut_index $CRLF_index
} elseif { $output_length - $letter_index > $limit } {
set CRLF_index -1
set cut_index $range_end
} else {
set CRLF_index -1
set cut_index $output_length
}
# La condition suivante prévoit le cas où la limite tombe sur un \n.
if { $letter_index != $cut_index } {
if { $CRLF_index == -1 } {
lappend output [string range $data $letter_index $cut_index]
} else {
lappend output [string range $data $letter_index [expr {$cut_index - 1}]]
}
}
set letter_index [expr {$cut_index + 1}]
}
return $output
}



Exemple
Code :
split_line "Ceci est une ligne de texte beaucoup trop longue pour être affichée intégralement sur une seule ligne de vingt caractères." 20
Tcl: {Ceci est une ligne} {de texte beaucoup} {trop longue pour} {être affichée} {intégralement sur} {une seule ligne de} {vingt caractères.}

http://www.boulets.oqp.me/tcl/routines/t...-0014.html
Toute l'actualité de mes scripts ici     (dernière mise à jour le 22/04/2020)

Tout programme comporte au moins un bug et pourrait être raccourci d'au moins une instruction, de quoi l'on peut déduire que tout programme peut être réduit à une seule instruction qui ne fonctionne pas.
  Répondre


Atteindre :


Utilisateur(s) parcourant ce sujet : 1 visiteur(s)