Skip to main content

Displaying pango strings in a gnocl::text widget.

After deciding that I'd wasted enough time looking at C coding to convert pango markup strings to text tags, I decided to script in Tcl. Got the project completed in less than an hour! Ok, there are some trade-offs, this is why the GtkText does not handle pango. It relies upon tags, and not markup strings. There is some code out there to render pango in a textview but, it will create new tags each and every time a text attribute changes. What I want to achieve is pango in and pango out. I've now got something working in Tcl which meets my needs but makes some compromises. In order to use tags, and not markup, only a limited range of settings are available. As I want the basics to change the font styling and the fg/bg colours for highlighting, I can be satisfied with a limited tag set. To make life easier, I've also named these after the pango markup. These make for some pretty unusual markup-strings, but hey - they work!

The following script reveals all.



# test-pango-text-widget.tcl

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

#---------------
#
#---------------
proc gnocl::pango_init {w} {
   
    $w tag create <b> -fontWeight bold
    $w tag create <i> -fontStyle italic
    $w tag create <u> -underline single
    $w tag create <s> -strikethrough 1   
    $w tag create <tt> -font Courier
   
    $w tag create <span_background="cyan"> -background cyan   
    $w tag create <span_background="magenta"> -background magenta   
    $w tag create <span_background="yellow"> -background yellow
    $w tag create <span_background="grey"> -background grey
   
    $w tag create <span_foreground="red"> -foreground red   
    $w tag create <span_foreground="blue"> -foreground blue   
    $w tag create <span_foreground="black"> -foreground black
    $w tag create <span_foreground="grey"> -background grey   
}

#---------------
#
#---------------
proc gnocl::pango_parse {s w} {
   
    set textString ""
    set ::textTags ""
   
    # for each character in the string
    for {set i 0} {$i < [string length $s] } {incr i} {
           
        # get character
        set char [string index $s $i]
               
        # is it the start of a markup tag
        if { $char == "<"} {
               
            # insert any existing text
            $w insert end $textString -tags $::textTags
            set textString ""
           
            # test for span tags
            if { [string range $s 1 4 ] == "span" } {
                puts SPAN!
                # get the tag name
                set j [string first ">" $s $i]
                set tag [string range $s $i $j]
                set tag [string map [::list " " "_"] $tag]
            } else {
                # get the tag name
                set j [string first ">" $s $i]
                set tag [string range $s $i $j]
            }       
                       
            # increment counter to skip tag
            set i $j
           
            # tagON or tagOFF?
            if { [string first "/" $tag ] == -1 } {
                # tagON
                append ::textTags " " $tag
                set ::textTags [string trimleft $::textTags]
            } else {
                # tagOFF
                # check span
                if {$tag == "</span>"} {
                    ##puts spanOFF
                    ##puts 1>>>$::textTags<<<
                    set l [string first "<span" $::textTags ]
                    set m [string first ">" $::textTags $l]
                    set o [string range $::textTags $l $m]
                    ##puts 2>>>$o<<<
                    set ::textTags [string map [::list $o ""] $::textTags]
                    ##puts 3---$::textTags---
                } else {
                    # remove turned off tags from the tagList
                    set tag [string map [::list / ""] $tag]
                    set ::textTags [string map [::list $tag ""] $::textTags]
                    $w insert end $textString -tags $::textTags
                    set textString ""
                }
            }
        } else {
            append textString $char
        }
    }
    # insert any trailing text without markup
    # at this point any values remaining in the textTags list
    # will not be ballanced and so ignored
    set textTags [string map [::list " " ""] $::textTags]
    if {$textTags != ""} {
        puts "WARNING: Unbalanced tag(s) $textTags ignored.\n\n\t$s"
        }
    $w insert end $textString
}

set box [gnocl::box -orientation vertical]
set lab(1) [gnocl::label]
set txt(1) [gnocl::text]
set txt(2) [gnocl::text -baseColor #FFFEDA]
set but(1) [gnocl::button -icon %#Paste]

$but(1) configure -onClicked {
    set str(3) [$txt(2) get start end]
    $txt(1) clear
    gnocl::pango_parse $str(3) $txt(1)
    $lab(1) configure -text $str(3)
}

$box add $lab(1) -fill {1 0} -expand 1
$box add $txt(1) -fill {1 1} -expand 1
$box add $txt(2) -fill {1 1} -expand 1
$box add $but(1) -align left -expand 0 -fill {0 0}
gnocl::window -child $box -setSize 0.25

gnocl::pango_init $txt(1)





Comments

Popular posts from this blog

gnocl::calendar

Given this module some attention today. Added some of the more package wide options to the module and created customised handler for setting the month. (For some odd reason months are are counted 0-11 whereas days are 1-31.) There's still a little more to do to this one including the addition of code to store diary details. Here's the working test script to show the range of options at work. The percentage substitution string item %e explores something that I've been toying with, the name of the signal/event that initiated the call. Ok, a script can keep its own internal trace but who knows, it might prove useful. #--------------- # calendarTest.tcl #--------------- # Author:   William J Giddings # Date:     07/05/09 #--------------- #!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" "$@" #--------------- package require Gnocl set cal [gnocl::calendar] $cal configure -day 8 -month 7 -year 1956 $cal configure -rowHeight 1 -colWidth 1 $ca

Simple Runtime Debugging Message Dialog

At times it's useful to see what values variables hold, or offer some pause point before the code goes elsewhere before causing havoc. Its possible to write output to the terminal but this can get lost in copious forms of other outputs, besides, there's no pausing the script execution either. The following proc creates a custom dialog which displays ad message along with the point in the calling script from which it was invoked. ## simple runtime debugging feedback dialog, alternative to console based gnocl::msg # @param msg message to display # @returns none # proc xxx::msg {txt} { set frame [info frame -1] append msg "Message:\n\n" append msg " $txt \n\n\n" append msg "Called from:\n\n" append msg "Proc:\t[lindex [info level -1] 0]\n" append msg "File:\t[file tail [dict get $frame file]]\n" append msg "Line:\t[dict get $frame line]\n" gnocl::dialog \ -type info \ -text $msg

Creating a button box with right aligned widgets

The dialog widget has its own internal functionaluty to create and position buttons at the bottom right corner of the window container. When creating these for ourselves it must be born in mind that default settings for fill and expand are both 0.5. Failing to set these will always place the child objects in the centre, regardless of alignment. For most cases these defaults are acceptable but, to create that dialog-button arrangement, use the following snippet as a model!   # to right align completely, set expand and fill to 0 set hbox [gnocl::hBox] set b1 [gnocl::button -text Select \                -data $lst                 -onClicked { puts DO-SOMETHING-WITH-%d} ] set b2 [gnocl::button -text Cancel -onClicked { puts DONE! } ] $vbox add $hbox -expand 0 -fill 0 -align right $hbox add $b1 $hbox add $b2