##############################################################################
### 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 { [::tcl::string::length $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 [::tcl::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 [::tcl::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 {
([::tcl::string::index $data [set test_cut_index [expr {$limit - $i}]]] eq "\003")
&& ([regexp {^\003([0-9]{1,2}(,[0-9]{1,2})?)} [::tcl::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 [::tcl::string::range $data 0 $cut_index]
set data [::tcl::string::range $data $cut_index+1 end]
if { [::tcl::string::trim [::tcl::string::map [list \002 {} \037 {} \026 {} \017 {}] [regsub -all {\003([0-9]{0,2}(,[0-9]{0,2})?)?} $new_part {}]]] ne "" } {
lappend output [::tcl::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 { [::tcl::string::trim [::tcl::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) && ([::tcl::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)
&& ([::tcl::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
}
}