% A reasonably competent Scheme mode. Should be usable for other lisps 
% too, though the keywords will be wrong.
% 
%   * Indents using the standard Lisp/Scheme convention [ i.e.
%     (foo (bar)
%          (really-long name
%             parameter)))                              ]
%   * Contains all R5RS keywords.
%   * DFA support needed for displaying symbols as highlighted (with the
%     color 'string').
%
%
% 2001-10-13 / Juho Snellman <jsnell@iki.fi>
%   * First public release.
%
% 2001-10-18 / Juho Snellman <jsnell@iki.fi>
%   * Fixed stack overflows.
%   
% 2001-12-07 / Juho Snellman <jsnell@iki.fi>
%   * Added comment strings.

% scheme mode

create_syntax_table ("scheme");
define_syntax ("(", ")", '(', "scheme");
define_syntax (";", "", '%', "scheme");
define_syntax ('"', '"', "scheme");
define_syntax ('\\', '\\', "scheme");

define_syntax ("0-9a-zA-Z_!$%&*+-./:<=>?@^_~", 'w', "scheme");        % words
define_syntax ("-+0-9", '0', "scheme");   % Numbers

#ifdef HAS_DFA_SYNTAX
%%% DFA_CACHE_BEGIN %%%
static define setup_dfa_callback (name)
{
    dfa_enable_highlight_cache ("scheme.dfa", name);
    dfa_define_highlight_rule (";.*$", "comment", name);
    dfa_define_highlight_rule ("#[tf]", "keyword", name);
    dfa_define_highlight_rule ("\"([^\\\\\"]|\\\\.)*\"", "string", name);
    dfa_define_highlight_rule ("\"([^\\\\\"]|\\\\.)*$", "string", name);
    dfa_define_highlight_rule ("'[^'][a-zA-Z]+", "string", name);
    dfa_define_highlight_rule ("[\\(\\)]", "Qdelimiter", name);
    dfa_define_highlight_rule ("[0-9A-Za-z_!\\$\\%\\&\\*\\+\\-\\.\\/\\:\\<\\=\\>\\?\\@\\^\\_\\~]+",
                               "Knormal", name);
    dfa_define_highlight_rule (".", "normal", name);
    dfa_build_highlight_table (name);
}
dfa_set_init_callback (&setup_dfa_callback, "scheme");
%%% DFA_CACHE_END %%%
#endif

() = define_keywords ("scheme","*+---///<=>", 1);
() = define_keywords ("scheme","<=>=doififor", 2);
() = define_keywords ("scheme","absandcarcdrcoseq?expgcdlcmletletlogmapmaxminnotsintan", 3);
() = define_keywords ("scheme","acosasinassqassvatanatancaarcadrcasecondconseqv?evalexptlet*listloadmemqmemvodd?readreadset!sqrt", 4);
() = define_keywords ("scheme","angleapplyassocbeginchar?delayeven?floorforcelist?null?pair?quotereal?roundwritewritezero?", 5);
() = define_keywords ("scheme","appendcdddarcddddrchar<?char=?char>?defineequal?exact?lambdalengthletrecmembermodulostringvaluesvector", 6);
() = define_keywords ("scheme","ceilingchar<=?char>=?displaydisplaynewlinenewlinenumber?reversestring?symbol?vector?", 7);
() = define_keywords ("scheme","boolean?complex?for-eachinexact?integer?list-refquotientset-car!set-cdr!string<?string=?string>?truncate", 8);
() = define_keywords ("scheme","char-ci<?char-ci=?char-ci>?imag-partlist-tailmagnitudenegative?numeratorpeek-charpeek-charpositive?rational?read-charread-charreal-partremainderstring<=?string>=?substring", 9);
() = define_keywords ("scheme","char-ci<=?char-ci>=?let-syntaxmake-polarprocedure?quasiquotestring-refvector-refvector-refwrite-charwrite-char", 10);
() = define_keywords ("scheme","char-ready?char-ready?char-upcasedenominatoreof-object?input-port?make-stringmake-stringmake-vectormake-vectormake-vectormake-vectorrationalizestring-ci<?string-ci=?string-ci>?string-copystring-set!vector-set!", 11);
() = define_keywords ("scheme","dynamic-windlist->stringlist->vectoroutput-port?string->liststring-ci<=?string-ci>=?string-fill!vector->listvector-fill!", 12);
() = define_keywords ("scheme","char->integerchar-downcasechar-numeric?integer->charletrec-syntaxstring-appendstring-lengthtranscript-onvector-length", 13);
() = define_keywords ("scheme","exact->inexactinexact->exactnumber->stringnumber->stringstring->numberstring->numberstring->symbolsymbol->stringtranscript-off", 14);
() = define_keywords ("scheme","open-input-file", 15);
() = define_keywords ("scheme","call-with-valueschar-alphabetic?char-lower-case?char-upper-case?char-whitespace?close-input-portmake-rectangularnull-environmentopen-output-file", 16);
() = define_keywords ("scheme","close-output-port", 17);
() = define_keywords ("scheme","current-input-port", 18);
() = define_keywords ("scheme","current-output-portwith-output-to-file", 19);
() = define_keywords ("scheme","call-with-input-filewith-input-from-file", 20);
() = define_keywords ("scheme","call-with-output-file", 21);
() = define_keywords ("scheme","interaction-environment", 23);
() = define_keywords ("scheme","scheme-report-environment", 25);
() = define_keywords ("scheme","call-with-current-continuation", 30);

define start_of_next_word ()
{
    push_spot();
    
    EXIT_BLOCK {
        pop_spot();
    }
        
    % First we find either eol, or some whitespace
    while ( (not eolp()) and
            (not (what_char() == ' ')) and
            (not (what_char() == '\t')) )
      () = right(1);
        
    % No interesting words found
    if (eolp()) return -1;
    
    % Now we find either an eol, or the start of the word
    while ( (not eolp()) and
            ((what_char() == ' ') or
             (what_char() == '\t')) )
      () = right(1);
    
    % No interesting words found
    if (eolp()) return -1;

    return what_column();
}
    

define scheme_indent_line ()
{
    variable col = 0;
    
    push_spot();
    
    EXIT_BLOCK {
        pop_spot();
        bol_trim();
        whitespace(col);
        bol_skip_white();
    }
    
    bol();

    if (find_matching_delimiter(')') == 1) {
        col = what_column();
    } else {
        col = 0;
        return;
    }
    
    % The indent immediately following define seems to be specialcased 
    % in the lisp community.
    if (looking_at("(define"))
    {
        col += 2;
    }
    else
    {
        variable col2 = start_of_next_word();
        
        % Make a normal indent
        if (col2 < 0)
            col += 2;
        % Indent to the next non-white
        else
            col = col2-1;
    }
}

!if (keymap_p ("scheme")) make_keymap ("scheme");

define scheme_mode ()
{
    set_mode("scheme", 2);
    set_buffer_hook ("indent_hook", "scheme_indent_line");
    use_syntax_table ("scheme");
    use_keymap ("scheme");
    set_comment_info ("scheme", ";", "", 0);
    run_mode_hooks ("scheme_mode_hook");
}