1 #!/usr/sww/bin/wish4.0-b4

     2 set COLORED_WORDS {}

     3 text .t -background white -foreground black

     4 pack .t  

     5 set LOW_PRECISION_BACKGROUND green

     6 set MISPELLED_BACKGROUND blue

     7 set UNKNOWN_CHAR_BACKGROUND red

     8 .t tag configure LOW_PRECISION -background $LOW_PRECISION_BACKGROUND

     9 .t tag configure MISPELLED -background $MISPELLED_BACKGROUND

    10 .t tag configure UNKNOWN_CHAR -background $UNKNOWN_CHAR_BACKGROUND

    11 proc addword { w {xpos 0} {ypos 0} {status OK}} {

    12     global COLORED_WORDS

    13     puts $status

    14     if { ![string compare $status OK] } {

    15 	.t insert end "$w " 

    16 	.t mark set insert end

    17 	.t mark set insert "end -2 char"

    18 	.t tag add $status "insert wordstart" "insert wordend"

    19 	.t tag add x$xpos "insert wordstart" "insert wordend"

    20 	.t tag add y$ypos "insert wordstart" "insert wordend"

    21 	.t mark set insert end

    22     } elseif { ![string compare $status LOW_PRECISION] || ![string compare $status MISPELLED] || ![string compare $status UNKNOWN_CHAR] } {

    23 	.t insert end "$w "

    24 	.t mark set insert end

    25 	.t mark set insert "end -3 char"

    26 	.t tag add $status "insert wordstart" "insert wordend"

    27 	.t tag add x$xpos "insert wordstart" "insert wordend"

    28 	.t tag add y$ypos "insert wordstart" "insert wordend"

    29 	lappend COLORED_WORDS [.t index insert]

    30 	.t mark set insert end

    31     } else {

    32 	puts stdout "Unknown word status for $w: $status"

    33 	.t insert end "$w UNKNOWNSTATUS? "

    34     }

    35 }

    36 

    37 proc pop_colored_words { } {

    38     global COLORED_WORDS

    39     set x [lindex $COLORED_WORDS 0]

    40     if {[llength $COLORED_WORDS] == 1} {

    41 	set COLORED_WORDS {}

    42     } elseif {[llength $COLORED_WORDS] == 0} {

    43 	set COLORED_WORDS $COLORED_WORDS

    44     } else {

    45 	set COLORED_WORDS [lrange $COLORED_WORDS 1 [llength $COLORED_WORDS]]

    46     }

    47     return $x

    48 }

    49 

    50 bind .t <Tab> {

    51     if {[llength $COLORED_WORDS] == 0} {

    52 	puts stdout "No more words"

    53     } else {

    54 	.t mark set insert [pop_colored_words]

    55 	.t mark set insert "insert wordstart"

    56 	set x [.t index insert]

    57 	puts "New index is $x"

    58 	.t see insert

    59 	set local_tags [.t tag names insert]

    60 	puts "Tags at this place: $local_tags"

    61     }

    62     break

    63 }