/*   This is version 1 of DCL mode for VMS op/sys.  Color coding
 *  currently limited to my standard-color scheme, but easy to modify.
 *  Tagging functions are ad hoc for my needs.  I tag LABELS,
 *  @ signs, 'sqlplus', and 'sqlload'.   Tagging defined for *.COM
 *  files.
 *  Ted Zuschlag    ted_zuschlag@ous.edu    June 2000. 
 *  */
#include "eel.h"
#include "proc.h"
#include "colcode.h"
#include "c.h"

char _dcl_mode_name[] = "DCL"; 
keytable dcl_tab;
// color_class text color_scheme "standard-color" green on black;
color_class dcl_comment;   // a comment, !something
color_class dcl_keyword;   // like set, open, write
color_class dcl_identifier;  //  like idntfier = "value", Symbols usually
// color_class dcl_label;  //  like PWPWCTL:  in other words a goto tag
color_class dcl_string;    //  like "value"
color_class dcl_number;    //  i dunno
color_class dcl_punctuation;  // anything else
int color_dcl_range();
int color_dcl_from_here();

color_scheme "standard-color" {
	color_class dcl_comment white;
	color_class dcl_keyword yellow;
	color_class dcl_identifier green;
	color_class dcl_string cyan;
	color_class dcl_number dark_green;
	color_class dcl_punctuation dark_cyan;
}; 

color_dcl_from_here(safe)	// Move backward to the nearest line guaranteed
{                               // to start outside any colored region, return pos.
	re_search(-1,"^<Dollar>");
	return point;               // Just start from the top.  See also HTML
}

color_dcl_range(from, to)	// recolor just this section
{				// last colored region may go past to
	int t = -1, talk, s;
	char pat[200];

	if (from >= to)
		return to;
	save_var point, matchstart, matchend;
	dcl_init_color(from , to);
	point = from;
	talk = (to - from > 2000);	// show status during long delays
	save_var case_fold = 0;
	while (point < to) {            
		if (!re_search(1,"[A-Za-z0-9_$]+|[\"!]|(^<Dollar>)" )) {
			t = size();
			break;
		}
		t = matchstart;
		switch (character(point - 1)) {		// check last char
			case '"':		// found a string literal
				point = t;
				re_search(1, "\"([^\"\\\n]|\\(.|\n))*[\"\n]");
				set_character_color(t, point, color_class dcl_string);
				if (get_character_color(point, (int *) 0, &s) == 
					  color_class dcl_string && s > to)  // fix up after
					dcl_init_color(point, to = s); // quoted "'s
				break;
			case '!':			// found comment
				nl_forward();
				set_character_color(t, point, color_class dcl_comment);
				break;
			case '$':			//  new line.  Also punc are = . @ : ][ by default
				set_character_color(t, point, color_class dcl_punctuation);
				break;
			default:		// found identifier, kywd, or number
				set_character_color(t, point, dcl_keyword_color(t) );
				break;
		}
		if (talk)
			note("Coloring DCL program: %d%% complete...",
				 (point - from) * 100 / (to - from));
	}
	dcl_init_color(to, t);
	if (talk)
		note("");
	return point;
}
dcl_init_color(from, to)
{
	if (from < to)
		set_character_color(from, to, minimal_coloring
							? color_class dcl_keyword
							: color_class dcl_punctuation);
}
dcl_keyword_color(from)	// return color for "identifier" from here to point
{						// (something with alpha or digits)
	char buf[500];

	if (point - from > sizeof(buf) - 10)
		save_var point = from + sizeof(buf) - 10;
	buf[0] = '|';		// get identifier, between | chars
	grab(from, point, buf + 1);
//   Wish I could test for labels:  here, to color them differently.
	if (index("0123456789-.", buf[1]))
		return c_number_color(buf + 1);
	strcpy(buf + point - from + 1, "|");
	if (is_dcl_keyword(buf))
		return color_class dcl_keyword;
	return color_class dcl_identifier;
}

is_dcl_keyword(p)	// is text in p (must be surrounded by |'s) a keyword?
char *p;
{
	case_fold = 1;
	if (strstr("|create|open|write|close|read|append|rename|ren|delete|del|purge|"
			   "define|def|nolog|eqs|nes|not|and|or|type|", p))
		return 1;
	if (strstr("|gosub|"
			   "goto|if|then|else|endif|"
			   "on|error|submit|dir|", p))
		return 1;
	if (strstr("|set|verify|noverify|noon|default|search|return|"
			   "f$search|f$extract|f$time|f$edit|f$jpi|f$environment|f$mode|"
               "f$cvtime|f$length|"
			   "sqlload|sqlplus|email_notifier|", p))
		return 1;
	return 0;
}

command dcl_mode()
{
	mode_keys = dcl_tab;
    major_mode = _dcl_mode_name;
    strcpy (comment_begin, "!");
    strcpy (comment_end, "");
    strcpy (comment_start, "($!)[ <tab>]*");
    strcpy (comment_pattern, "$!(.|<newline>)*");

    recolor_range = color_dcl_range;	// set up coloring rules
    recolor_from_here = color_dcl_from_here;
    if (want_code_coloring)		// maybe turn on coloring
        when_setting_want_code_coloring();
    make_mode();
    try_calling("dcl-mode-hook");
}

suffix_com()
{
    dcl_mode();
}

tag_dcl_script()
{
    char func[70];
    int start, opoint = point, ofold = case_fold;

    case_fold = 1;
    point = 0;
    while (re_search(1,"^<Dollar>[ \t]*[A-Z0-9_]+:"))   // LABELS:
     {
		to_begin_line();	// wish I did not get $ also
		re_search(1, "([A-Z0-9_]+:)");
		grab(start = find_group(1, 1), find_group(1, 0), func);
        add_tag(func, start);
    };
	case_fold = 1;
	point = 0;
	while (re_search(1,"<hspace>+@"))  // any line with @ control transfers
	{
		re_search(1, "<FB><Max>(.)+$");
		grab(start = find_group(1, 1), find_group(1, 0), func);
		add_tag(func, start);
	};
	case_fold = 1;
	point = 0;
	while (re_search(1,"<hspace>+(sqlplus|sqlload)"))  // any line with @ control transfers
	{
		point = matchstart;
		re_search(1, "<FB><Max>(sqlplus|sqlload)(.)+$");
		grab(start = find_group(1, 1), find_group(1, 0), func);
		add_tag(func, start);
	};
    case_fold = ofold;
    point = opoint;
}	

tag_suffix_com()		/* tag pl/sql proc and func calls */
{
    tag_dcl_script();
}