1 rizwank 1.1 /**
  2              * Name: tcl
  3              * Description: Tcl programming language.
  4              * Author: Markku Rossi <mtr@iki.fi>
  5              */
  6             
  7             state tcl_comment extends Highlight
  8             {
  9               /[^\\\\]\n/ {
 10                 language_print ($0);
 11                 return;
 12               }
 13             }
 14             
 15             state tcl_proc_arglist extends Highlight
 16             {
 17               /* List of arguments. */
 18               /{/ {
 19                 language_print ($0);
 20                 variable_name_face (true);
 21                 str = match_balanced_block (/{/, /}/);
 22 rizwank 1.1     variable_name_face (false);
 23                 language_print (str);
 24                 return;
 25               }
 26               /* Only one argument. */
 27               /[A-Za-z0-9]+/ {
 28                 variable_name_face (true);
 29                 language_print ($0);
 30                 variable_name_face (false);
 31                 return;
 32               }
 33               /* No idea what this is??? */
 34               /[.\n]/ {
 35                 language_print ($0);
 36                 return;
 37               }
 38             }
 39             
 40             state tcl extends HighlightEntry
 41             {
 42               /* Comments. */
 43 rizwank 1.1   /#/ {
 44                 comment_face (true);
 45                 language_print ($0);
 46                 call (tcl_comment);
 47                 comment_face (false);
 48               }
 49               /#\n/ {
 50                 comment_face (true);
 51                 language_print ($0);
 52                 comment_face (false);
 53               }
 54             
 55               /* String constants. */
 56               /\"/ {
 57                 string_face (true);
 58                 language_print ($0);
 59                 call (c_string);
 60                 string_face (false);
 61               }
 62             
 63               /* Procedure definitions. */
 64 rizwank 1.1   /\b(proc)([ \t]+)([A-Za-z_0-9]+)([ \t]+)/ {
 65                 /* Keyword `proc'. */
 66                 keyword_face (true);
 67                 language_print ($1);
 68                 keyword_face (false);
 69             
 70                 /* Middle garbage. */
 71                 language_print ($2);
 72             
 73                 /* Function name. */
 74                 function_name_face (true);
 75                 language_print ($3);
 76                 function_name_face (false);
 77             
 78                 /* Second middle garbage. */
 79                 language_print ($4);
 80             
 81                 /* Function argument list. */
 82                 call (tcl_proc_arglist);
 83               }
 84             
 85 rizwank 1.1   /* Simple variable reference. */
 86               /(\$)([A-Za-z_0-9]+)/ {
 87                 language_print ($1);
 88                 variable_name_face (true);
 89                 language_print ($2);
 90                 variable_name_face (false);
 91               }
 92             
 93               /* {}-enclosed variable reference. */
 94               /\${/ {
 95                 language_print ($0);
 96                 variable_name_face (true);
 97                 str = match_balanced_block (/{/, /}/);
 98                 variable_name_face (false);
 99                 language_print (str);
100               }
101             
102               /* Keywords.
103                  (build-re '(
104                  ;; Tcl:
105                  Http Tcl after append array bgerror break case catch cd clock
106 rizwank 1.1      concat continue eof error eval exec exit expr fblocked fconfigure file
107                  fileevent filename flush for foreach format gets glob global history
108                  if incr info interp join lappend library lindex linsert list llength
109                  load lose lrange lreplace lsearch lsort open package pid pkg_mkIndex
110                  proc puts pwd read regexp regsub rename return scan seek set socket
111                  source split string subst switch tclvars tell time trace unknown unset
112                  update uplevel upvar vwait while
113             
114                  ;; Tk:
115                  bell bind bindtags bitmap button canvas checkbutton clipboard destroy
116                  entry event focus font frame grab grid image label listbox lower menu
117                  menubutton message option options pack photo place radiobutton raise
118                  scale scrollbar selection send text tk tk_bindForTraversal tk_bisque
119                  tk_chooseColor tk_dialog tk_focusFollowsMouse tk_focusNext
120                  tk_focusPrev tk_getOpenFile tk_getSaveFile tk_menuBar tk_messageBox
121                  tk_optionMenu tk_popup tk_setPalette tkerror tkvars tkwait toplevel
122                  winfo wm
123                  ))
124                */
125               /\b(Http|Tcl|a(fter|ppend|rray)\
126             |b(ell|gerror|i(nd(|tags)|tmap)|reak|utton)\
127 rizwank 1.1 |c(a(nvas|se|tch)|d|heckbutton|l(ipboard|ock)|on(cat|tinue))|destroy\
128             |e(ntry|of|rror|v(al|ent)|x(ec|it|pr))\
129             |f(blocked|configure|ile(|event|name)|lush|o(cus|nt|r(|each|mat))|rame)\
130             |g(ets|lob(|al)|r(ab|id))|history|i(f|mage|n(cr|fo|terp))|join\
131             |l(a(bel|ppend)|i(brary|n(dex|sert)|st(|box))|length|o(ad|se|wer)\
132             |r(ange|eplace)|s(earch|ort))\
133             |me(nu(|button)|ssage)|op(en|tion(|s))\
134             |p(ack(|age)|hoto|id|kg_mkIndex|lace|roc|uts|wd)\
135             |r(a(diobutton|ise)|e(ad|g(exp|sub)|name|turn))\
136             |s(c(a(le|n)|rollbar)|e(ek|lection|nd|t)|o(cket|urce)|plit|tring|ubst\
137             |witch)\
138             |t(clvars|e(ll|xt)|ime\
139             |k(\
140             |_(bi(ndForTraversal|sque)|chooseColor|dialog\
141             |focus(FollowsMouse|Next|Prev)|get(OpenFile|SaveFile)\
142             |me(nuBar|ssageBox)|optionMenu|popup|setPalette)\
143             |error|vars|wait)\
144             |oplevel|race)\
145             |u(n(known|set)|p(date|level|var))|vwait|w(hile|info|m))\b/ {
146                 keyword_face (true);
147                 language_print ($0);
148 rizwank 1.1     keyword_face (false);
149               }
150             }
151             
152             
153             /*
154             Local variables:
155             mode: c
156             End:
157             */