% ocaml mode 

create_syntax_table ("ml");
define_syntax ("([", ")]", '(', "ml");
define_syntax ("(*", "*)", '%', "ml");
define_syntax ('"', '"', "ml");
define_syntax ('\\', '\\', "ml");
define_syntax ("|=+:;<>~!'", '+', "ml");

define_syntax ("0-9a-zA-Z_", 'w', "ml");        % words
define_syntax ("-+0-9", '0', "ml");   % Numbers
% define_syntax ('#', '#', "ml");	       %  preprocessor

#ifdef HAS_DFA_SYNTAX
%%% DFA_CACHE_BEGIN %%%
static define setup_dfa_callback (name)
{
    dfa_enable_highlight_cache ("ml.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, "ml");
%%% DFA_CACHE_END %%%
#endif

() = define_keywords ("ml","asdoifinoforto", 2);
() = define_keywords ("ml","andendforfunletnewnotrecsigtryval", 3);
() = define_keywords ("ml","doneelselazyopenthentruetypewhenwhenwith", 4);
() = define_keywords ("ml","beginclassfalsematchwhile", 5);
() = define_keywords ("ml","assertdowntomethodmoduleobjectparserstruct", 6);
() = define_keywords ("ml","functorincludeinheritmutableprivatevirtual", 7);
() = define_keywords ("ml","externalfunction", 8);
() = define_keywords ("ml","exception", 9);
() = define_keywords ("ml","constraint", 10);
() = define_keywords ("ml","initializer", 11);

variable ml_ind = 2;

define ml_line_ends_with(s) {
    push_spot();
    
    EXIT_BLOCK {
	pop_spot();
    }
    
    eol();
    bskip_white();
    return blooking_at(s);
}

define ml_find_opening(s) {
    push_spot();
    
    EXIT_BLOCK {
	pop_spot();
    }
    
    !if (re_bsearch("[ \t^]" + s + "[ \t\n]")) {
	error("Delimiter not found: " + s);
    }
    () = right(1);
    
    % TODO: Check that this isn't inside a string/comment
    return what_column()-1;
}

define ml_opening_keyword () {
    if (looking_at("let ")) {
	if (ml_line_ends_with("="))
	  return ml_ind;
	if (ml_line_ends_with(" in"))
	  return ml_ind;
    }
    
    if (looking_at("method ")) {
	if (ml_line_ends_with("="))
	  return ml_ind;
	return 0;
    }
    
    if (looking_at("object ") or looking_at("object\n")) {
 	return ml_ind;
    }
    
    if (looking_at("if ")) {
	if (ml_line_ends_with(" then"))
	  return ml_ind;
	return strlen("if ");
    }
    
    if (looking_at("for ")) {
	if (ml_line_ends_with(" do"))
	  return ml_ind;
	return strlen("for ");
    }
    
    if (looking_at("class ")) {
	if (ml_line_ends_with(" end"))
	  return 0;
	return ml_ind;
    }
    
    if (looking_at("try ") or looking_at("try\n")) {
	return ml_ind;
    }
    
    if (looking_at("with ") or looking_at("with\n")) {
	return ml_ind;
    }
    
    if (looking_at("else ") or looking_at("else\n"))
      return ml_ind;
    
    if (looking_at("in ") or looking_at("in\n"))
      return ml_ind;
    
    if (ml_line_ends_with(" ->"))
      return ml_ind;
        
    if (ml_line_ends_with(" function"))
      return ml_ind;
    
    if (ml_line_ends_with(" and")) {
	variable c =  what_column()-1;
	eol();
	!if (re_bsearch("\\=")) {
	    error("Delimiter not found: =");
	}
	bskip_word();	
	% vinsert("%d %d", c, what_column());
	return what_column() - 1 - c;
    }
    
    % Multi-line if
    if (ml_line_ends_with(" then"))
      return ml_ind - strlen(" if");
    
    return 0;
}

define ml_matching_keyword () {
    % if (eolp()) {
    % 	!if (up(1)) {
    % 	    return 0;
    % 	}
    % 	if (ml_line_ends_with(";;")) {
    % 	    return 0;
    % 	} 
    % 	bol_skip_white();
    % 	return what_column()-1;
    % }
    if (looking_at("with ") or looking_at("with\n")) {
	return ml_find_opening("try");
    }    
    if (looking_at("else ") or looking_at("else\n")) {
	return ml_find_opening("if");
    }    
    if (looking_at("done")) {
	return ml_find_opening("for");
    }    
    if (looking_at("in ") or looking_at("in\n")) {
	return ml_find_opening("let");
    }    
    return -1;
}

define ml_indent_line () {
    variable col = -1;
    
    push_spot();
    
    EXIT_BLOCK {
        pop_spot();
        bol_trim();
	if (col > 0)
	  whitespace(col);
        bol_skip_white();
    }
    
    bol_skip_white();
    
    col = ml_matching_keyword();
    
    if ( col < 0 and up(1) ) {
	bol_skip_white();
	col = what_column() - 1 + ml_opening_keyword;	
    }    
}

define ml_mode () {
    set_mode("ml", 2);
    set_buffer_hook ("indent_hook", "ml_indent_line");
    use_syntax_table ("ml");
    set_comment_info ("ml", "(* ", " *)", 0);
    run_mode_hooks ("ml_mode_hook");
}