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 [::tcl::string::trim $data]
	set data_length [::tcl::string::length $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 [::tcl::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 [::tcl::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 [::tcl::string::trimright [::tcl::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 { [::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
	}
}



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 [::tcl::string::length $data]
	set letter_index 0
	while {$letter_index < $output_length} {
		if {
		([set CRLF_index [::tcl::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 [::tcl::string::range $data $letter_index $cut_index]
			} else {
				lappend output [::tcl::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
Répondre Avertir


Atteindre :


Utilisateur(s) parcourant ce sujet : 1 visiteur(s)
Tchat 100% gratuit -Discutez en toute liberté