Wednesday, December 14, 2011

More on Pango Markup Strings

I don't like fiddling around with markup strings, even at the best of times. So, any convienient way of producing the right formatting is welcome news to me. Gtk widgets allow markupstrings for various text elements. So, I thought, how about creating strings on the fly using familiar Tcl means. Hence the following two procs below. One will create markup and the other remove it. The removal method is still basic, it will also strip out markup-like items such as <b> so its use is limited. It is also assumed that there will only be one "<span"  entry per string. Modifying the code to remove more that one <span group should not be too much of an issue.

The need behind creating these procs comes from wanting to quickly add/remove markup strings from tree/listview cells.

#---------------
# pango_string.tcl
#---------------
# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Gnocl

#---------------
# Create Pango formatted string.
#---------------
# Arguments
#    str        The text string to format.
#    args    Matched pair of options and values.
# Returns
#---------------
proc pango_string {str args} {
    set span_str ""
    foreach {a b} $args {
        puts "a = $a b = $b"
        switch -- $a {
            -big {
                if {$b} {set str  "<big>$str</big>" }
                }
            -bold {
                if {$b} { set str  "<b>$str</b>" }
                }
            -italic {
                if {$b} { set str  "<i>$str</i>" }
                }
            -small {
                if {$b} { set str  "<small>$str</small>" }
                }
            -strikethrough {
                if {$b} { set str  "<s>$str</s>" }
                }
            -sub {
                if {$b} { set str  "<sub>$str</sub>" }
                }
            -sup {
                if {$b} { set str  "<sup>$str</sup>"}
                }
            -tt {
                if {$b} { set str  "<tt>$str</tt>" }
                }
            -bg -
            -bgClr -
            -background {
                append span_str " background=\"$b\""
                }
            -fallback {
                append span_str " fallback=\"$b\""
                }
            -font {
                append span_str " font=\"$b\""
                }
            -fg -
            -fgClr -
            -foreground {
                append span_str " foreground=\"$b\""
                }
            -gravity {
                append span_str " gravity=\"$b\""
                }
            -gravityHint {
                append span_str " gravity_hint=\"$b\""
                }               
            -lang {
                append span_str " lang=\"$b\""
                }
            -rise {
                append span_str " rise=\"$b\""
                }
            -style {
                append span_str " style=\"$b\""
                }   
            -size {
                append span_str " size=\"$b\""
                }
            -letterSpacing {
                append span_str " letter_spacing=\"$b\""
                }
            -stretch {
                append span_str " stretch=\"$b\""
                }
            -strikethroughColor {
                append span_str " strikethrough_color=\"$b\""
                }
            -underline {
                if {$b == 1} {
                    set str  "<u>$str</u>"
                    } else {
                    append span_str " underline=\"$b\""
                    }
                }
            -underlineColor {
                append span_str " underline_color=\"$b\""
                }
            -variant {
                append span_str " size=\"$b\""
                }
            -weight {
                append span_str " size=\"$b\""
                }

        }
    }
   
    if {$span_str != ""} {
        set str "<span $span_str>$str</span>"
    }
   
    return $str
}


if {1} {
    set box [gnocl::box -orientation vertical]

    for {set i 0} {$i <= 5} {incr i} {
        set lab($i) [gnocl::label]
        $box add $lab($i)
    }

    $lab(0) configure -text [pango_string "Hello World" -bold 1]
    $lab(1) configure -text [pango_string "Hello World" -bold 1 -foreground red]
    $lab(2) configure -text "[pango_string "Hello" -bold 1 -foreground red] [pango_string "World" -bold 1 -foreground blue -italic 1]"
    $lab(3) configure -text "[pango_string "Hello" -stretch ultraexpanded -bold 1 -foreground red] [pango_string "World" -bold 1 -foreground blue -italic 1]"
    gnocl::window -child $box
}

#---------------
# Remove pango formatting from a string.
#---------------
# Arguments
#    str        string with pango markup
# Returns
#    plain text string
# Notes
#   Use with caution.
#    Will also strip <u> etc., from within text strings.
#---------------
proc pango_remove {str} {
    set str [string map {
        <u>     "" </u>     ""
        <b>     "" </b>     ""
        <i>     "" </i>     ""
        <s>     "" </s>     ""
        <big>   "" </big>   ""
        <small> "" </small> ""
        <sub>   "" </sub>   ""
        <sup>   "" </sup>   ""
        <tt>    "" </tt>    ""
        </span> ""
    } $str]

    # remove span
    set i [string first "<span" $str]
    if {!$i} {
        set j [string first ">" $str]
        set str [string range $str [incr j] end]
    }


    return $str
}

if {1} {
    set markup(block) "-fg red -bold 1"
    set str [eval pango_string "NO-<b>PANGO" $markup(block) ]
    puts $str
    puts ==|[pango_remove $str]|==
}


Sunday, December 11, 2011

gnocl::list add

I've finished taking a look at enhancing the add sub-command ensuring bakcward compatibility with the legacy effects. This snippet shows how it works:

widget-id add rowNum data options

$list add    { "A" 1 } -singleRow 1    ;# 1
$list add {} { "B" 2 } -singleRow 1    ;# 2
$list add  0 { "C" 3 } -singleRow 1    ;# 3
$list add -1 { "D" 4 } -singleRow 1    ;# 4
$list add  3 { "E" 5 } -singleRow 1    ;# 5

In order for the interpretor to know which row to use the second argument needs to be an integer. '0' means insert at the top of the list with -1 the bottom. In a pre-existing list, any other positive value in between will insert at the appropriate level. If the specified row is a value that exceeds the length of the list, the item will be appended to the end.
The command returns the number of the row just inserted.

Finally, providing a non integer values will also result in appending the value to the bottom of the list unless an empty string is provided which will prepend the entry to the top.

PS> Just noted that setting the -singleRow option is compulsory rather than an option! I'll look at this later today.






Saturday, December 10, 2011

**NEW COMMAND** gnocl::showURI

A simple wrapper around the gtk_show_uri utility function. This will launch the GNOME default applications for mailing and browsing.

Rather than explicitly calling a browser with:

$m4 configure -onClicked "
        exec firefox http://www.buddhism-dict.net/cgi-bin/xpr-ddb.pl?q=[$w get selectionStart selectionEnd] &
        "


The same effect can be achieved with

$m4 configure -onClicked "
        gnocl::showURI "http://www.buddhism-dict.net/cgi-bin/xpr-ddb.pl?q=[$w get selectionStart selectionEnd]
        "


Tuesday, November 29, 2011

gnocl::text new option -data, new command cget

Been adding a few tweaks to the code today. Added the -data option and the cget command. Also slightly modified the percentage substitution strings for the gnocl::entry -onIconPress event handler. Hitherto %t would have provided details about a the mousebutton event. It makes more sense to us %b allowing %t to be used to substitute the contents of the entry buffer.

Finally, I'm working on a simple text editing widget to add to the gnocl::megawidgets package. Its nothing fancy, no rich text editing, just a simple scribble pad to embed in those app which might need it!

Wednesday, November 16, 2011

gnocl::paned

Ok, there's not much left to do with this one but... Added a cget command which enable some simple querying. Still working on the binding for the handle move. For some reason there's no binding for mouse operations, just keyboard adjustment.

Friday, November 11, 2011

gnocl::calendar

Had some feedback today on the gnocl::calendar. I've taken a look at the developement sources and have now wrapped my debugging/testing lines in #ifdef blocks. This means that users will not be inundated with debugging messages. There will still be cases, however, when the Gtk+ libraries write warning and error messages to the console.

The revised version is now available from SourceForge.

Thursday, October 27, 2011

gnocl::fileChooser completed support for multiple file type filters

Wanted to fix this one for some time. Basically, this allows multiple file filters to be set for the dialog. The sample script explains all.


# basic Tcl/Gnocl Script
#!/bin/sh \
exec tclsh "$0" "$@"
package require Gnocl


set ff1 [gnocl::fileFilter -name "Source Code" -pattern {*.tcl *.c} ]
set ff2 [gnocl::fileFilter -name "Text Files" -pattern {*.odt *.doc *.rtf *.abw} ]
set ff3 [gnocl::fileFilter -name "Image Files" -pattern {*.png *.jpg *.bmp *.tif} ]

gnocl::fileChooserDialog \
            -fileFilters [list $ff1 $ff2 $ff3]
            -currentFolder [pwd] \
            -title "Open Jiumoluo Project File"


15mins later....

Urgh, something always goes wrong. It looks like the destruction of the dialog window also results in the destuction of the file filters object too! I'll rework the code so that the filters are maintained as a list on the Tcl side; something along the lines of:

set filters {Filter1Name {*.A  *.B *.C} Filter2Name {*.D *.E *.F} }

15mins later....

Ok, rework the code and all now appears ok. In fact the core is much slimmer now as the code overhead for making the gnocl::fileFilter command was too much. So, the following script works. I'll upload a nightly build today.

set myFilters {Source {*.c *.tcl} Text {*.txt *.odt} Graphics {*.png *.jpg *.tif} }

gnocl::window -child [gnocl::button -text click-me -onClicked {
        gnocl::fileChooserDialog \
            -fileFilters $myFilters \
            -currentFolder [pwd] \
            -title "Open Jiumoluo Project File -1"
        }]


Thursday, October 06, 2011

gnocl::text getting tag names and properties

Just added another useful tag sub-command: properties. This command is pretty useful for obtaining the non-default property settings for text tags. For example;

foreach t [lsort [$::petxt tag names]] {
    puts "$t [$::petxt tag properties $t]"
}




Tuesday, October 04, 2011

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)





Friday, September 30, 2011

Return to coding!

Its been almost a month since a last posting. How time flies. Most of my time has been taken up between making some final adjustments to my Ph.D thesis prior to submission and chasing up a whole pile of work related matters. But now, for a while at least, I can give some more attention to Gnocl. The last issue that I was working was inserting/retrieving Pango markup strings with a GtkTextBuffer. After solving something of a glitch in adding tags to single characters (I'd completely forgotten that iters are invalid after changes to the content of text buffer. Resolved the problem through the use of markers as in function that I've just added to the code:

        GtkTextMark *tagStart, *tagEnd;
        GtkTextIter start, end;
       
        tagStart  = gtk_text_buffer_create_mark (buffer,"tagStart", iter, 1);           
                
        gtk_text_buffer_insert  (buffer, iter, txt, -1);

        tagEnd = gtk_text_buffer_get_insert(buffer);

        applyTags (buffer, tag, tagStart, tagEnd);



Where:

void applyTags (GtkTextBuffer *buffer, gchar *tag, GtkTextMark *tagStart, GtkTextMark *tagEnd) {
   
        GtkTextIter start, end;
   
        gtk_text_buffer_get_iter_at_mark(buffer,&start,tagStart);
        gtk_text_buffer_get_iter_at_mark(buffer,&end,tagEnd);
        gtk_text_buffer_apply_tag_by_name  (buffer,tag, &start,&end);
   
}


At the moment single tags are fine, ie bold but it might be necessary to nest tags, ie bold-underline. The next question is, should I pass a string of tag names, or a linked-list? I'll think about this one tomorrow!



Thursday, September 01, 2011

More on generating pango strings...

This is not so easy a 'nut to crack'. I've noticed that the solution that I've come up with so far fails to implement nested markup, ie <b> <s> text </s></b>. Conversely, getting the <span> </span> block is an issue too! Clearly there is a need for this functionality, but there is no clear solution that I can find. The Gimp developers are working on something similar but I notice that they have problems with <span> too!

So, I've gone back to basics. Rather than relying the pango string parser, I'll put something together of my own. Today I've been working on some extra string funcs. Here's what I've produced so far:

/*
gcc -o first first.c
*/

#include <stdio.h>
#include <string.h>
 
/**
    search for first occurance of p in s, starting from i
    done
**/
int strnfrst(char *s, char *p, int i)
{
        char *f;
        int l;
       
        l = strlen(p);  /* length of search string */
        f = s+i;
 
        /* search through string till match found */
        while (*f != '\0') {
                if ( !strncmp(f, p, l) ) {
                    return f-s;
                }
                f++;
        }
        return -1;
}

/**
    extract a range of characters from string s starting from position a to position b
    done
**/
char *strrng (char *dest, const char *src, int a, int b) {
  unsigned i,j;
 
  j=0;
  for (i=a; i<b; i++)
  {
    dest[j++] = src[i];
  }
  dest[j] = '\0';
  return dest;

}

/*
char *strcpy(char *dest, const char *src)
{
  unsigned i;
  for (i=0; src[i] != '\0'; ++i)
    dest[i] = src[i];
  dest[i] = '\0';
  return dest;
}
*/

/**
    gettag
    get name of next tag in string, starting at position i
**/
int getTag (char *str, char *tag, int i) {

        int a,b;
       
        a = strnfrst(str,"</",i);
       
        if (a) {
            a = strnfrst(str,"<",i);
        }
       
        b = strnfrst(str,">",a+1);

        strrng(tag,str,a,b+1);
       
        return a;
}


/**
    test
**/
int main()
{

        // p in s, starting from i
        char str1[] = "abCdefC";
       
        int i = strnfrst(str1, "C", 0);
        int j = strnfrst(str1, "C", i+1);
        printf("locations %d %d in %s\n",i,j,str1);

        char buf[32];

        /* get the characters between the Cs */
        printf("'%s' lies between chars %d and %d\n",strrng (buf,str1, i+1,j),i+1,j);

        char str2[] = "<b>bold</b>   <i>italic</i>   <u>underline</u>   <s>strikethrough</s>";

        printf("text range 3 thro' 8 = '%s'\n", strrng (buf, str2, 3, 8));

        /* get the next tag in the string */
        i= getTag (str2, buf, 3);
        printf("next tag %s at pos %d\n", buf, i);
       
        i=getTag (str2, buf, i+1);
        printf("next tag %s at pos %d\n", buf, i);

        /* parse the whole string */
        // get the position of the first tag toggle
        i = getTag (str2, buf, 0);
        printf("%d %s\n",i,buf);
       
        // parse the remainder of the string
        while ( i < strlen(str2) ) {
            i=getTag (str2, buf, i+1);
            printf("%d %s\n",i,buf);
           
        }

        return 0;

}


Sunday, August 07, 2011

gnocl::rtf

Just created a binding to the Osxcart module which provided rtf import and export for GtkTextBuffers. Its a lot of coding for what is effectively a couple of library calls! The API allows for loading from files, but it seems more appropriate to import and export strings.

#---------------
# test-rtf.tcl
#---------------
# Created by William J Giddings
# 07-August-2011
#---------------
# Description:
# Import/Export rtf formatted files from gnocl::text widgets.
#---------------

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

package require Gnocl
package require GnoclOsxCart

set txt [gnocl::text]

gnocl::window -child $txt

gnocl::rtf register $txt

set fp1 [open "p006a_hello_world.rtf" "r"]
set fp2 [open "test.rtf" "w"]

gnocl::rtf import $txt [read $fp1]
close $fp1

puts $fp2 [gnocl::rtf export $txt]
close $fp2

Saturday, July 30, 2011

New Sourcecode Module textTag.c

Added a new module to the core source, textTag.c. The creation of this module is simply to separate out tag related functions from the the text.c module. It looks like this will be a hefty file. The tag object has a great number of properties that need to be wrapped.

The timing of this corresponds to expanding the gnocl::text widget functionality to enable the 'dump' of buffer contents in a manner similar to Tk. Got most of it working now.

Tuesday, July 26, 2011

Loading a simple tag table

 Here's a quick way of creating multiple tags in one go.

set tagTable {
    {{Header 1} -font {Sans 12 Bold} }
    {{Header 2} -font {Sans 10 Bold} }
    {{Body} -font {Serif 10} -wrapMode word }
}

foreach {a} $tagTable {
    eval "$txt tag create $a"
}

$txt insert end \n
$txt insert end MANTRA\n -tags { {Header 1} }
$txt insert end "Om Ah Hum\n" -tags Body

gnocl::text tags

Still working on extending the text tag functionality. Its quite interesting really as it requires more understanding of the really powerful Tcl command libraries to build lists etc. Today I've added some extra functionality which pretty well follows the same guidelines of the Tk text widget, i.e.  tag names, raise and lower.

I'm still working on the robust parsing of tag options. One little tip for those out there, who like me, want spaces in names. Use the following to create tags:

$txt tag create [list {Heading 1}]

or,

$txt tag create {{Heading 1}}

If tags need to created proceedurally, then try:

$txt tag create [list [list $tagName]]



Friday, July 22, 2011

gnocl::text -markupTags

Extending pango markup string support is something of a challenge. One option that I've just added to the gnocl::text widget is -markupTags. This will specify whether to implement a set of tags corresponding to the 'Convenience Tags' listed in the Gnocl docs. Apart from saving time when scripting, this will allow the parsing of the text buffer for names tags for output of text blocks in pango markup. For example:

$txt insert end "APPLE" -tags {b}

can be parsed and output as:

<b>APPLE<\b>

The same should be possible for span attributes too:

$txt insert end "APPLE" -tags {b fg=r bg=y}

could be parsed and output as:

<span fgcolor="red" bgcolor="yellow"<b>APPLE<\b><\span>

Thursday, July 21, 2011

gnocl::text - tag dumping

Now that its possible create tags by either direct specification or through the use of Pango markup strings, its feasible to require the conversion of text buffer contents back into some form of markup format. Saving off large amounts of text as markup is ill-advised, use serialization to save/reload large buffers. What is in mind here is the ability to edit some rich text in a text buffer and then submit it for display in a list cell or label. Might sound an odd thing to do, but my translation editor does just this. A large body of writing is converted from a text file to a list, one entry per paragraph. These paragraphs are displayed in a gnocl::list in one column and their English translations in a second column alongside. Pango markup would allow those areas in the translation to be highlighted for future review.

Previously I had the bare bones of a widget 'dump' command in place and am now making further headway. Last night I added a 'ranges' sub-command to return the locations of where specific named tags are located. The recently added gtktextviewpango module also needed revisiting in order to add automatic tag naming.

Plan (hope, wish?) to complete this one before the end of the month.

Wednesday, July 20, 2011

gnocl::text now supports pango markup

Spent some time today looking at how to implement the rendering Pango markup strings in the gnocl::text widget. Found a module in the StarDict app that was exactly what was needed! It took a couple of minutes to added it to the gnocl sources, modify the makefile text.c module.

Screenshot:




Test script.

# test-text-pango.tcl
#!/bin/sh
#\
exec tclsh "$0" "$@"

package require Gnocl

set pango_string(0)  {%<<span foreground="blue">Hello</span> <span foreground="red">World</span>}
set pango_string(1)  {<span foreground="blue">Hello</span> <span foreground="red">World</span>}
set pango_string(2)  {%<<span foreground="blue">Hello</span> <span foreground="red">World</span>}

set txt [gnocl::text]
gnocl::window -child $txt -width 600 -height 150

# the string is parse, and the leading %< stripped
$txt insert end $pango_string(0)\n
$txt insert end $pango_string(1)\n
$txt insert end $pango_string(2)

Tuesday, July 19, 2011

gnocl::listPicker -done

Completed this megawidget. Here's the script:

# test-listPicker.tcl
#!/ bin/sh
#\
exec tclsh "%0" "$@"
package require Gnocl

#---------------
# megawidget to contain Ok/Cancel buttons
#---------------
proc gnocl::listPicker { args } {
    set titles {"Item" data}
    set types {string string}
    set ls(from) [gnocl::list \
        -titles $titles \
        -types $types ]
    set ls(to) [gnocl::list \
        -titles $titles \
        -types $types ]   
    # are any names data?
    set i [lsearch $titles data ]
    $ls(from) columnConfigure $i -visible 0
    $ls(to) columnConfigure $i -visible 0
   
    #~~~~~~~~~~~~~~~
    # move items between two lists
    #~~~~~~~~~~~~~~~       
    proc ::moveItem { from to i} {
        set active [$from getSelection]
        if {$active == ""} {return}
        set rows [$from getNumChildren]
        set a [$from get $active 0]
        set b [$from get $active 1]
        $from erase $active
        set rows [$from getNumChildren]
        # set new active row
        if { $active < $rows } {
            $from setSelection $active
        } elseif {$rows == 1} {
            $from setSelection 0
        } else {
            if { $rows != 0 } { $from setSelection [incr rows -1] }
        }
        $to add "\{\{$a\} \{$b\}\}"
    }

    #~~~~~~~~~~~~~~~
    # return a list of selected items
    #~~~~~~~~~~~~~~~
    proc ::getList { w } {
        set r 0
        while {$r < [$w getNumChildren] } {
            lappend str [ list [$w get $r 0] [$w get $r 1] ]
            incr r
        }
        return $str
    }

    # selection buttons
    set but(from) [gnocl::button \
        -icon %#GoForward \
        -onClicked  "::moveItem $ls(from) $ls(to) $i" ]
       
    set but(to) [gnocl::button \
        -icon %#GoBack \
        -onClicked "::moveItem $ls(to) $ls(from) $i"]
   
    set bx(1) [gnocl::fixed ]
    $bx(1) add $but(from) \
        -x 0 -y 50 \
        -width 70 -height 35
    $bx(1) add $but(to) \
        -x 0 -y 100 \
        -width 70 -height 35
    set bx(2) [gnocl::box]
    $bx(2) add $ls(from) \
        -fill {1 1} \
        -expand 1
    $bx(2) add $bx(1) -fill {0 1}
    $bx(2) add $ls(to) \
        -fill {1 1} \
        -expand 1
    $bx(2) configure -data $ls(to)
   
    # allocate which elements get which settings
    foreach {a b} $args {
        switch -- $a {
            -items {
                # create from list from supplied items
                foreach row $b {
                    $ls(from) add "\{$row\}"   
                }
            }
            -headersVisible {
                # create from list from supplied items
                $ls(from) configure $a $b   
                $ls(to) configure $a $b
            }
            default {
                # nothing in here yet!
            }
        }
    }

    # overload the box to add commands
    rename $bx(2) _$bx(2)

    #~~~~~~~~~~~~~~~
    # overload box widget to create new commands
    #~~~~~~~~~~~~~~~
    proc $bx(2) {cmd args} {
        set self [lindex [::info level 0] 0]
            switch -- $cmd {
                get {
                    return [::getList [_$self cget -data] ]
                    }
                default {uplevel 1 _$self $cmd $args}
                }
    }

    return $bx(2)
}

set items {
    {New "New File"}
    {Open "Open File"}   
    {Save "Save File"}
    {Help "Help Me"}
    }

set box [gnocl::box -orientation vertical]
set lp [gnocl::listPicker -items $items -headersVisible 0]
set bt [gnocl::button -text "Get Selected Options" -onClicked { puts [$lp get]}]
$box add $lp -fill {1 1} -expand 1
$box add $bt -fill {0 0} -expand 0 -align right

gnocl::window -child $box -setSize 0.25

Monday, July 18, 2011

gnocl::listPicker

Things on the Gnocl front have been quiet these past few days. My work load has been heavy and my second hard-drive on my workstations (ie HOME) started giving me sector errors which, is always bad news. Coupled with this, my workstation has parts in it dating back to the mid-1990s and so spares are scarce! Well, as luck would have it I still have spare drives floating around from a pile of old Acer laptops one of which will soon me in my OpenSUSE workstation. At the moment, running on a totally reliable (yet very noisy) 8.5GB IBM PATA hard drive circa 1998 so space is tight. However, spent a couple of hours this evening putting the basics together for a scripted listchooser widget. Here's a screenshot:



My prototype in running ok at the moment and, once finished, I'll post the code to the Gnocl website.


Sunday, July 03, 2011

cget -data

One of the great features of Tk/Gnocl widgets is data association. For some time now its been possible to set the -data options but not to extract it. The reason for this is that such associations are not gtk widget properties although support for the feature is via the Gdk libraries. I'm currently working on a Gnocl scripted megawidget which needs extra items of data passes to its events handlers, the -data option is ideal for this. Implementing the feature is a simple process, as the following code extract from the entry.c module cget function shows.

static const int variableIdx = 0;
static const int onChangedIdx = 1;
static const int valueIdx = 2;
static const int cursorIdx = 3;
static const int primaryIconIdx = 4;
static const int secondaryIconIdx = 5;
static const int dataIdx = 6;

static GnoclOption entryOptions[] =
{
    /* gnocl unique and complex options handled through configure */
    { "-variable", GNOCL_STRING, NULL },        /* 0 */
    { "-onChanged", GNOCL_STRING, NULL },   /* 1 */
    { "-value", GNOCL_STRING, NULL },            /* 2 */
    { "-showCursor", GNOCL_BOOL, NULL},      /* 3 */
    { "-primaryIcon", GNOCL_OBJ, NULL },        /* 4 */
    { "-secondaryIcon", GNOCL_OBJ, NULL },    /* 5 */
    { "-data", GNOCL_OBJ, "", gnoclOptData },  /* 6 */
...

static int cget ( Tcl_Interp *interp, EntryParams *para, GnoclOption options[], int idx )
{
    if ( idx == dataIdx )
    {
        obj = Tcl_NewStringObj ( g_object_get_data ( para->entry, "gnocl::data" ), -1 );
    }
...


The next step is ensuring that the functionality works for all widgets.

Saturday, July 02, 2011

gnocl::text - obtaining names of tags applied to specific locations

The following script shows how to obtain details of which tag applies to a particular position in a block of text.

#---------------
# test-tag-get.tcl
#---------------
#!/bin/sh
#\
exec tclsh "$0" "$@"

package require Gnocl

set txt [gnocl::text -baseFont {Serif 14}]
$txt tag create red -foreground red
$txt tag create black -foreground black
$txt tag create bold -fontWeight bold

gnocl::window -child $txt -setSize 0.25

$txt insert end "the quick brown fox " -tags red
$txt insert end "jumps " -tags {red bold black}
$txt insert end "over the lazy dog" -tags red

$txt configure -onKeyRelease {
    puts [%w tag get [%w getCursor]]
    }

$txt configure -onButtonRelease {
    puts [%w tag get [%w getCursor]]
    }