Got this Tcl formatting pango markup strings based upon predefined tags in a gnocl::text widget. At the moment a core set of tags is intialized by setting the -markupTags option to '1'. Like many instances of machine produced code the markup strings are lengthy! But it works. When I have the time I'll look at implementing a C version of the proc an incorporating it into the gnocl sources. At that point it might be worth considering the creation of a new gnocl widget for the task as a separate package.
#---------------
# obtain markup strings from gnocl::text object
#---------------
# args:
# txt gnocl text widget containing rich text
# return
# string with suitable pango markups
# notes:
# initialize preset markup tags in widget using the -markupTags 1 option
proc gnocl:text_pango {txt} {
set str ""
for {set line 0} {$line < [$txt getLineCount]} {incr line} {
set char 0
while {$char < [$txt getLineLength $line]} {
# get ch at specific line position
set ch [ $txt get [::list $line $char] [::list $line [expr $char+1] ] ]
# process active tags at this position in the line
set tagON ""
set tagOFF ""
# get tags as a list
set tags [$txt tag get [list $line $char]]
foreach tag $tags {
append tagON $tag
if {[string first span $tag] != -1} {
lappend tagOFF </span>
} else {
lappend tagOFF [string map [list < </] $tag ]
}
}
# reverse the tagOff list, remove whitepaces
set tagOFF [lreverse $tagOFF]
set tagOFF [string map [list { } {}] $tagOFF]
# add characers and markup to output string
append str $tagON $ch $tagOFF
incr char
} ;# end while
} ;# end for
return $str
}
#---------------
# obtain markup strings from gnocl::text object
#---------------
# args:
# txt gnocl text widget containing rich text
# return
# string with suitable pango markups
# notes:
# initialize preset markup tags in widget using the -markupTags 1 option
proc gnocl:text_pango {txt} {
set str ""
for {set line 0} {$line < [$txt getLineCount]} {incr line} {
set char 0
while {$char < [$txt getLineLength $line]} {
# get ch at specific line position
set ch [ $txt get [::list $line $char] [::list $line [expr $char+1] ] ]
# process active tags at this position in the line
set tagON ""
set tagOFF ""
# get tags as a list
set tags [$txt tag get [list $line $char]]
foreach tag $tags {
append tagON $tag
if {[string first span $tag] != -1} {
lappend tagOFF </span>
} else {
lappend tagOFF [string map [list < </] $tag ]
}
}
# reverse the tagOff list, remove whitepaces
set tagOFF [lreverse $tagOFF]
set tagOFF [string map [list { } {}] $tagOFF]
# add characers and markup to output string
append str $tagON $ch $tagOFF
incr char
} ;# end while
} ;# end for
return $str
}
Comments