File: //usr/share/jed/lib/tclmode.sl
% tcl mode 0.5 (derived from shmode.sl, cmode.sl and latex.sl)
% by David Schweikert (dwschwei@stud.ee.ethz.ch)
%
% ChangeLog
% ---------
% 0.1 18 Aug 97 Initial version
% 0.2 25 Aug 97 The indenting is much better. Small bug fixes.
% Escaped braces correctly parsed.
% 0.3 31 Aug 97 Syntax highlighting reworked. Now only Tcl/Tk
% commands are highlighted.
% Highlighting of command options added.
% Syntax Check added.
% 0.4 27 Sep 97 Little bugfix in indenting.
% 0.5 24 Feb 98 Integrated into the JED distribution.
% Added syntax highlighting for numbers.
%
% Description
% -----------
% JED-mode for the syntax-highlighting and automatic indentation of
% Tcl/Tk programs.
%
% Notes
% -----
% - This mode only does DFA syntax-highlighting and a very
% rough automatic indentation (assumes that the previous line
% is correctly indented)
% - How to highlight is very personal... Modify the code to match your
% preference!
% - I am very disponible for comments, suggestions,... (via e-mail)
%
% Keybindings
% -----------
% ^C^Q tcl_indent_region
% { tcl_insert_bra
% } tcl_insert_ket
% # tcl_insert_comment
%
% Syntax Check
% ------------
% This mode does recognise evident syntax-errors which are common
% to beginners (I am a beginner :-)):
%
% - The open brace should be opened on the same line of the command
% it belongs to and not on a line by itself as many do in C:
% Wrong: Right:
% if {$a == 1} if {$a == 1} {
% { set b 2
% set b 2 }
% }
% Note that the open-brace at the beginning of a line could be
% correct but isn't certainly common.
%
% - The comment is also a sort of command in Tcl, so you can't just add
% comments on the right of some statement. You have to add
% a command separator if you want to:
% # this is right
% set a 2 # this is wrong
% set b 3 ;# this is right
%
% If tclmode recognises such an error, it displays a "Warning: ...".
% You can disable the Syntax Check by setting 'Tcl_Check_Syntax' to 0.
%
% Syntax-highlighting
% -------------------
% The syntax-coloring-types of jed aren't very adequate for tcl,
% so, I used them as follows:
%
% - normal: as expected
% - comment: as expected
% - delimiter: as expected
% - string: as expected (plus "$variable")
% - keyword: as expected (tcl: type 0, tk: type 1)
% - number: as expected
% - preprocess: proc definition (first line)
% - operator: command option (for example '-font')
%
% ToDo
% ----
% - More syntax-checks (ideas?).
% - Interaction with tclsh/wish (difficult).
% - Smarter indenting.
% - More commands from incr Tcl, BLT, ...
% - tcl_comment_region.
% - syntax highlighting without DFA.
variable Tcl_Check_Syntax = 1;
% ---
$1 = "TCL";
create_syntax_table ($1);
#ifdef HAS_DFA_SYNTAX
%%% DFA_CACHE_BEGIN %%%
private define setup_dfa_callback (name)
{
dfa_enable_highlight_cache ("tclmode.dfa", name);
dfa_define_highlight_rule ("^[ \\t]*#.*$", "comment", name);
dfa_define_highlight_rule (";[ \\t]*#.*$", "comment", name);
dfa_define_highlight_rule ("\"([^\\\\\"]|\\\\.)*\"", "string", name);
dfa_define_highlight_rule ("[{}\\[\\]]", "Qdelimiter", name);
dfa_define_highlight_rule("[0-9]+(\\.[0-9]*)?([Ee][\\+\\-]?[0-9]*)?","number", name);
dfa_define_highlight_rule (".", "normal", name);
dfa_define_highlight_rule("[A-Za-z_\\.:]+", "Knormal", name);
dfa_define_highlight_rule ("\\$[a-zA-Z0-9_:]+", "string", name);
dfa_define_highlight_rule ("\\${.*}", "Qstring", name);
dfa_define_highlight_rule ("^[ \\t]*proc.*$", "Qpreprocess", name);
dfa_define_highlight_rule (" -[a-z]+ ", "operator", name);
dfa_build_highlight_table (name);
}
dfa_set_init_callback (&setup_dfa_callback, "TCL");
%%% DFA_CACHE_END %%%
#endif
% Keywords (machine generated)
% Tcl commands
$2 = 0;
() = define_keywords_n ($1, "cdif", 2, $2);
() = define_keywords_n ($1, "eofforpidpwdset", 3, $2);
() = define_keywords_n ($1, "caseelseevalexecexitexprfilegetsglobincrinfojoinlistloadopenprocputsreadscanseektelltime", 4, $2);
() = define_keywords_n ($1, "afterarraybreakcatchclockcloseerrorfcopyflushlsortsplitsubsttraceunsetupvarvwaitwhile", 5, $2);
() = define_keywords_n ($1, "appendbinaryconcatformatglobalinterplindexlrangeregexpregsubrenamereturnsocketsourcestringswitch", 6, $2);
() = define_keywords_n ($1, "consoleforeachhistorylappendlinsertllengthlsearchunknownuplevel", 7, $2);
() = define_keywords_n ($1, "continuefblockedlreplace", 8, $2);
() = define_keywords_n ($1, "fileevent", 9, $2);
% Tk commands
$2 = 1;
() = define_keywords_n ($1, "tkwm", 2, $2);
() = define_keywords_n ($1, "bellbindfontgrabgridmenupacksendtext", 4, $2);
() = define_keywords_n ($1, "entryeventfocusframeimagelabellowerplaceraisescalewinfo", 5, $2);
() = define_keywords_n ($1, "buttoncanvasoptiontkwaitupdate", 6, $2);
() = define_keywords_n ($1, "destroylistboxmessagetkerror", 7, $2);
() = define_keywords_n ($1, "bindtagstk_popuptoplevel", 8, $2);
() = define_keywords_n ($1, "clipboardscrollbarselectiontk_bisquetk_dialog", 9, $2);
() = define_keywords_n ($1, "menubutton", 10, $2);
() = define_keywords_n ($1, "checkbuttonradiobutton", 11, $2);
() = define_keywords_n ($1, "tk_focusNexttk_focusPrev", 12, $2);
() = define_keywords_n ($1, "tk_messageBoxtk_setPalette", 13, $2);
() = define_keywords_n ($1, "tk_chooseColortk_getOpenFiletk_getSaveFiletk_optionsMenu", 14, $2);
define tcl_indent_line (); % forward declaration
% Indentation and Syntax Check
define tcl_newline_and_indent ()
{
newline ();
tcl_indent_line ();
}
define tcl_indent_to (n)
{
bol_skip_white ();
if (what_column != n)
{
bol_trim ();
n--;
whitespace (n);
}
}
% Counts unmatched braces
define tcl_count_braces ()
{
variable c, open_count = 0, close_count = 0;
variable escaped = 0;
push_spot();
for(bol (); not(eolp()); go_right_1()) {
c = what_char ();
switch(c) {
case '\\': ifnot(escaped) escaped = 2;
}{
case '{': ifnot(escaped) open_count++;
}{
case '}': ifnot(escaped) {
if (open_count) open_count--;
else close_count++;
}
}
if(escaped) escaped--;
}
pop_spot();
return(open_count, close_count);
}
% Search for a valid previous line and go to it.
define tcl_go_up ()
{
forever {
if (up_1 ()) {
bol_skip_white ();
if (eolp ()) continue;
if (what_char () != '#') return(1);
}
else return(0);
}
}
% Is the next line the continuation of this one?
define tcl_is_continued_line ()
{
eol();
bskip_white ();
if (blooking_at ("\\")) 1;
else 0;
return;
}
% How much indenting based on the previous line?
define tcl_prev_line_rule ()
{
variable indent = 0, open_count;
push_spot ();
if(tcl_go_up ()) {
% It is assumed that this line is correctly aligned.
indent = what_column ();
% If we find first an unmatched '{', then the next line should be indented.
(open_count, ) = tcl_count_braces ();
indent += open_count * C_INDENT;
% Is the next a continuation line?
if (tcl_is_continued_line ()) indent += C_CONTINUED_OFFSET;
if (tcl_go_up() and tcl_is_continued_line()) indent -= C_CONTINUED_OFFSET;
}
pop_spot ();
return (indent);
}
% How much indenting based on the current line?
define tcl_cur_line_rule ()
{
variable indent = 0, close_count = 0;
% If we find an unmatched '}', then this line should be unindented.
(, close_count) = tcl_count_braces ();
indent -= close_count * C_INDENT;
return (indent);
}
% Indent the current line.
define tcl_indent_line ()
{
variable cursor, oldindent;
variable indent;
% ---- Could be skipped in tcl_indent_region!
cursor = what_column ();
bol_skip_white ();
oldindent = what_column ();
% ----
indent = tcl_prev_line_rule ();
indent += tcl_cur_line_rule ();
% message(Sprintf("%d : %d", indent_prev, indent_cur, 2));
tcl_indent_to (indent);
goto_column (cursor + indent - oldindent); % Could be skipped in tcl_indent_region!
}
% Indent the selected region (bound to ^C^Q)
define tcl_indent_region ()
{
check_region(1);
pop_mark_1 ();
push_mark();
tcl_indent_line(); % set initial line indentation before narrowing
pop_spot();
push_spot();
go_up_1 ();
narrow();
bob();
flush("Indenting region...");
while (down_1 ()) { % indent line by line (ie slowly)
tcl_indent_line();
% flush(Sprintf("Indenting line %d", what_line(), 1));
}
flush("Indenting region... Done.");
widen();
pop_spot();
}
define tcl_syntax_warning (msg)
{
flush ("Warning: " + msg);
}
define tcl_insert_ket ()
{
insert("}");
tcl_indent_line();
blink_match ();
}
define tcl_insert_bra ()
{
if(Tcl_Check_Syntax) {
push_spot();
bskip_white();
if(bolp()) {
tcl_syntax_warning("'{' shouldn't be on a separate line");
}
pop_spot();
}
insert("{");
}
define tcl_insert_comment ()
{
if(Tcl_Check_Syntax) {
push_spot();
bskip_white();
ifnot (bolp() or blooking_at (";")) {
tcl_syntax_warning("'#' should be on a separate line or after a ';'");
}
pop_spot();
}
insert("#");
}
$1 = "TCL";
ifnot (keymap_p ($1))
{
make_keymap ($1);
definekey("tcl_insert_bra", "{", $1);
definekey("tcl_insert_ket", "}", $1);
definekey("tcl_insert_comment", "#", $1);
definekey_reserved("tcl_indent_region", "^Q", $1);
definekey("indent_line", "\t", $1);
}
%!%+
%\function{tcl_mode}
%\synopsis{tcl_mode}
%\description
% Protoytype: Void tcl_mode ();
% This is a mode that is dedicated to facilitate the editing of Tcl language files.
% See the source (tclmode.sl) for more info.
% Functions that affect this mode include:
%#v+
% function: default binding:
% tcl_insert_bra {
% tcl_insert_ket }
% tcl_insert_comment #
% newline_and_indent RETURN
% indent_line TAB
% tcl_indent_region Ctrl-C Ctrl-Q
%#v-
% Variables affecting indentation include:
%#v+
% C_INDENT
% C_CONTINUED_OFFSET
%#v-
% Hooks: \var{tcl_mode_hook}
%!%-
define tcl_mode ()
{
variable mode = "TCL";
set_mode(mode, 4);
use_keymap(mode);
use_syntax_table (mode);
set_buffer_hook ("indent_hook", "tcl_indent_line");
set_buffer_hook ("newline_indent_hook", "tcl_newline_and_indent");
run_mode_hooks("tcl_mode_hook");
}