Sunday, April 29, 2012

Obtaining Pango Markup Strings -80% done!

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
}

No comments: