Update: For a faster, better, and simpler method see my Ctext highlighting widget: http://www.xmission.com/~georgeps/ctext/
There are several methods to provide syntax highlighting. This is my favorite so far. -GPS
#!/bin/sh
# \
exec wish8.3 "$0" "$@"
set comment_start 1.0
set comment_end 1.0
set comment_is_open 0
set busy 0
set s 1.0
set e 1.0
catch {source $env(HOME)/.wishrc}
proc area {single} {
#This finds the area to highlight.
global s e
if {$single == 0} {
set s 1.0
set e end
#puts "single 0 $single"
} else {
set s [.t index "insert linestart"]
set e [.t index "insert lineend"]
}
}
proc highlight {single} {
global comment_start comment_end comment_is_open busy s e
#set s 1.0
#set e end
if {$busy == 0} {
set busy 1
area $single
set pos 1.0
.t tag remove comment 1.0 end
while 1 {
update
set com [.t search -forward -exact {/*} $pos end]
if {$com != ""} {
#puts $com
set test [.t search -forward -exact {/*} "$com + 2 chars" end]
set com2 [.t search -forward -exact {*/} "$pos + 2 chars" end]
#puts $com2
if {$test != "" && $test < $com2} {
puts "There is an unbalanced comment at line $test."
break
}
if {$com2 != ""} {
.t tag add comment $com "$com2 + 2 chars"
.t tag configure comment -foreground khaki
set pos "$com2 + 2 chars"
}
}
}
if {$com == ""} {break}
update
}
.t tag remove flags $s $e
foreach fs {
"-text " "-command " "-yscrollcommand "
"-xscrollcommand " "-background " "-foreground " "-fg "
"-bg " "-highlightbackground " "-y " "-x " "-highlightcolor "
"-relief " "-width" "-height" "-wrap " "-font " "-fill "
"-side " "-outline " "-style " "-insertwidth " "-textvariable "
"-activebackground " "-activeforeground "
"-insertbackground " "-anchor " "-orient " "-troughcolor "
"-nonewline " "-expand " "-type " "-message "
"-title " "-offset " "-in " "-after " "-yscroll " "-xscroll "
} {
area $single
while 1 {
update
#puts 1
set fsr [.t search -forward -count fsrl -- $fs $s $e]
if {$fsr != ""} {
.t tag add flags $fsr "$fsr + $fsrl char"
.t tag configure flags \
-foreground DarkOrange1 \
-font {Courier 18 italic}
set s "$fsr + $fsrl char"
} else {
break
}
update
}
}
.t tag remove widgets $s $e
foreach ws {
{\mbutton\s} {\mlabel\s} {\mtext\s} {\mframe\s}
{\mtoplevel\s} {\mscrollbar\s} {\mcheckbutton\s} {\mcanvas\s}
{\mlistbox\s} {\mmenu\s} {\mmenubar\s} {\mmenubutton\s}
{\mradiobutton\s} {\mscale\s} {\mentry\s} {\mmessage\s}
} {
area $single
while 1 {
update
#puts 2
set wsr [.t search -forward -count wsrl -regexp $ws $s $e]
#puts $wsr
if {$wsr != ""} {
.t tag add widgets $wsr "$wsr + $wsrl char" e]
.t tag configure widgets -foreground MediumPurple2
catch {.t tag lower widgets flags}
set s "$wsr + $wsrl char"
} else {
break
}
update
}
}
}
.t tag remove braces $s $e
.t tag remove braces $s $e
foreach bs {\{ \( \) \} \[ \]} {
area $single
while 1 {
update
#puts 3
set bsr [.t search -forward -count bsrl $bs $s $e]
if {$bsr != ""} {
.t tag add braces $bsr "$bsr + $bsrl char"
.t tag configure braces -foreground green
set s "$bsr + $bsrl char"
} else {
break
}
update
}
}
.t tag remove quotes $s $e
foreach qs {\" \'} {
area $single
while 1 {
update
#puts 4
set qsr [.t search -forward -count qsrl $qs $s $e]
if {$qsr != ""} {
.t tag add quotes $qsr "$qsr + $qsrl char"
.t tag configure quotes -foreground {indian red}
set s "$qsr + $qsrl char"
}
if {$qsr == ""} {break}
update
}
}
.t tag remove structures $s $e
foreach sr {{\mset\s} {\mfor\s} {\mforeach\s} {\mwhile\s} {\mif\s}} {
area $single
while 1 {
update
set ssr [.t search -forward -count ssrl -regexp $sr $s $e]
if {$ssr != ""} {
.t tag add structures $ssr "$ssr + $ssrl char"
.t tag configure structures -foreground {red}
set s "$ssr + $ssrl char"
}
if {$ssr == ""} {break}
update
}
}
.t tag remove xlib_init $s $e
foreach sxlib {{\mDisplay\s} {\mWindow\s} {\mGC\s} {\mColormap\s} \
{\mXColor\s} {\mVisual\s}} {
area $single
while 1 {
update
set ssr [.t search -forward -count ssrl -regexp $sxlib $s $e]
#puts "WOW"
if {$ssr != ""} {
.t tag add xlib_init $ssr "$ssr + $ssrl char"
.t tag configure xlib_init -foreground {dodger blue}
set s "$ssr + $ssrl char"
}
if {$ssr == ""} {break}
update
}
}
.t tag remove c_tags $s $e
foreach c_tag {{\mint\s} {\mchar\s} {\mu_char\s} {\munsigned\s} \
{\mregister\s}} {
area $single
while 1 {
update
set ssr [.t search -forward -count ssrl -regexp $c_tag $s $e]
#puts "WOW"
if {$ssr != ""} {
.t tag add c_tags $ssr "$ssr + $ssrl char"
.t tag configure c_tags -foreground {dodger blue}
set s "$ssr + $ssrl char"
}
if {$ssr == ""} {break}
update
}
}
catch {.t tag raise comment flags}
catch {.t tag raise comment widgets}
catch {.t tag raise comment braces}
catch {.t tag raise comment structures}
catch {.t tag raise comment quotes}
catch {.t tag raise comment xlib_init}
catch {.t tag raise comment c_tags}
set busy 0
} ;#ENDIF
}
pack [text .t -font {10x20} -bg black -fg white] -expand yes -fill y
set fp [open "c.c" r]
.t insert 1.0 [read $fp]
close $fp
update
highlight 0
bind Text <Key> {}
bind Text <Key-BackSpace> {}
#This is used to get key names.
#bind Text <Key> {puts "%K"}
foreach char {
a b c d e f g h i j k l m n o p q r s t u v w x y z \
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
1 2 3 4 5 6 7 8 9 0 space comma period dollar numbersign exclam \
asciicircum colon semicolon equal bracketright bracketleft \
braceleft braceright minus plus backslash bar underscore parenleft \
parenright asterisk ampersand percent at asciitilde grave slash \
question less greater apostrophe quotedbl
} {
bind .t <Key-$char> {tkTextInsert .t %A; highlight 1}
}
bind .t <Key-BackSpace> {
#Most of this is data reported from bind Text <Key-BackSpace>
if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W delete sel.first sel.last
} elseif {[%W compare insert != 1.0]} {
%W delete insert-1c
%W see insert
}
highlight 1
}
bind .t <Control-s> {puts "This could invoke a save function."}Also see Jeffrey Hobbs' "Tcl source code to HTML compatible format converter. Does some intelligent highlighting" at http://www.tcl.tk/community/hobbs/tcl/script/main.html