'''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" } if {$fsr == ""} {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" .t tag configure widgets -foreground MediumPurple2 catch {.t tag lower widgets flags} set s "$wsr + $wsrl char" } if {$wsr == ""} {break} update } } .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" } if {$bsr == ""} {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 {} bind Text {} #This is used to get key names. #bind Text {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 {tkTextInsert .t %A; highlight 1} } bind .t \ { #Most of this is data reported from bind Text 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 {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://tcl.activestate.com/community/hobbs/tcl/script/main.html