/* Created: A long time ago * -- Sian Leitch * Updated: 2012-02-01 * -- Sian Mountbatten * Updated: 02-Feb-2013 6:34:09 am * -- Sian Mountbatten */ /* This file has Algol 68 mode */ #include "eel.h" #include "colcode.h" #include "proc.h" #include "c.h" #include "web68.h" /* No automatic indentation in this first version. * Restricted to lexical highlighting only. */ int web68_auto_show_delimiter() { save_var point, case_fold = 0; save_var matchstart, matchend, abort_searching = 0; init_auto_show_delimiter(); // Must do this first. point -= parse_string(-1, "[A-Z0-9 ]+"); *highlight_area_start[0] = point; if (parse_string(1, "BEGIN")) { *highlight_area_end[0] = matchend; if (!re_search(1, "END")) return 2; } else if (parse_string(1, "END")) { *highlight_area_end[0] = matchend; if (!re_search(-1, "BEGIN")) return 2; } else return 1; *highlight_area_start[1] = matchstart; // Mark the far end. *highlight_area_end[1] = matchend; modify_region(SHOW_MATCHING_REGION, MRTYPE, REGNORM); // Make the highlighting visible. return 3; } insert_algol68_construct(char *first, char *second, char *third, char *fourth) { int orig = point; bprintf("%s\n%s\n%s\n%s\n",first,second,third,fourth); point = orig+strlen(first); } command insert_algol68_if() on web68_tab[NUMSHIFT(FKEY(11))] { insert_algol68_construct("IF","THEN","ELSE","FI"); stuff(" "); } command insert_algol68_case() on web68_tab[NUMCTRL(FKEY(11))] { insert_algol68_construct("CASE","IN","OUT","ESAC"); insert(' '); } command insert_algol68_do() on web68_tab[NUMALT(FKEY(11))] { insert_algol68_construct("FOR","WHILE","DO","OD"); insert(' '); } command insert_algol68_doskip() on web68_tab[NUMSHIFT(FKEY(12))] { insert_algol68_construct("FOR","WHILE","DO SKIP OD",""); insert(' '); } command color_web68() on web68_tab[NUMCTRL(FKEY(12))] { fix_region(); set_character_color(point, mark, color_class default); point = color_web68_range(point, mark); highlight_off(); } /* command debug_color_region() { fix_region(); set_character_color(point, mark, color_class default); point = recolor_from_top(); } command debug_from_here() { point = color_web68_from_here(point); } debug_note(int cmd, char *fmt, char *str, int num, char ch) { if (debug_web68) switch (cmd) { case 1: buf_printf(web68_dbg, fmt, str); break; case 2: buf_printf(web68_dbg, fmt, num); break; case 3: buf_printf(web68_dbg, fmt, ch); break; case 4: buf_printf(web68_dbg, fmt, num, str); break; case 5: buf_printf(web68_dbg, fmt, str, num); break; case 6: buf_printf(web68_dbg, fmt, num, ch); break; default: buf_printf(web68_dbg, "Wrong index for debug_note\n"); break; } } debug_position(int where,int pos,char *prompt,char ch) { debug_note(2,"%d:",NULL,where,'@'); debug_note(2," position: %d,",NULL, buf_position_to_line_number(bufnum,give_begin_line()), '@'); debug_note(4,"%d %s=",prompt,pos - give_begin_line(),'@'); debug_note(3,"'%c'\n",NULL,0,ch); } debug_state(where, st) { char char_state[30]; switch (st) { case WEB68_HTML_STATE: strcpy(char_state, "WEB68_HTML_STATE"); break; case WEB68_ALGOL68_STATE: strcpy(char_state, "WEB68_ALGOL68_STATE"); break; case ALGOL68_LIMITED_STATE: strcpy(char_state, "ALGOL68_LIMITED_STATE"); } debug_note(4, "%d: web68_state=%s\n", char_state, where, '@'); } debug_token(where, tok) { char char_token[30]; switch(tok) { case ALGOL68_TOKEN_BANG: strcpy(char_token, "ALGOL68_TOKEN_BANG"); break; case ALGOL68_TOKEN_BAR: strcpy(char_token, "ALGOL68_TOKEN_BAR"); break; case ALGOL68_TOKEN_BOLD_TAG: strcpy(char_token, "ALGOL68_TOKEN_BOLD_TAG"); break; case ALGOL68_TOKEN_BRACKET: strcpy(char_token, "ALGOL68_TOKEN_BRACKET"); break; case ALGOL68_TOKEN_COMMENT: strcpy(char_token, "ALGOL68_TOKEN_COMMENT"); break; case ALGOL68_TOKEN_FORMAT: strcpy(char_token, "ALGOL68_TOKEN_FORMAT"); break; case ALGOL68_TOKEN_IDENTIFIER: strcpy(char_token, "ALGOL68_TOKEN_IDENTIFIER"); break; case ALGOL68_TOKEN_NUMBER: strcpy(char_token, "ALGOL68_TOKEN_NUMBER"); break; case ALGOL68_TOKEN_OPERATOR: strcpy(char_token, "ALGOL68_TOKEN_OPERATOR"); break; case ALGOL68_TOKEN_PUNCTUATION: strcpy(char_token, "ALGOL68_TOKEN_PUNCTUATION"); break; case ALGOL68_TOKEN_STRING: strcpy(char_token, "ALGOL68_TOKEN_STRING"); break; case ALGOL68_TOKEN_WEB68: strcpy(char_token, "ALGOL68_TOKEN_WEB68"); } debug_note(4, "%d: algol68_token=%s\n", char_token, where, '@'); } monitor(int where,char *msg) { debug_note(4,"%d: %s\n",msg,where,'@'); } */ color_web68_range(from, to) /* colour just this range */ { /* last coloured region may be > `to' */ int pos; if (from >= size()) return to; save_var point, matchstart, matchend, case_fold = 0; /* if (from < size()) set_character_color(from, size(), -1);*/ //point = from; to = to; point = 0; // buffer start to = size(); // buffer end while (point < to) { // debug_state(100,web68_state); switch (web68_state) { case WEB68_HTML_STATE: pos = point; // debug_note(3,"110: start='%c'\n",NULL,0,curchar()); if (!re_search(RE_FORWARD, "")) { set_character_color(pos,point,color_class algol68_html); return point; } // active char found set_character_color(pos,matchstart,color_class algol68_html); pos = matchstart; // debug_position(120,pos,"active char",character(matchstart)); switch (character(matchstart)) { case '"': search(1, "\""); set_character_color(pos, point, color_class algol68_html); break; case '@': // Web 68 command point = web68_cmd(matchstart, to); // point -> 2nd char of Web 68 cmd break; case '!': // Start of BANG mode web68_state = ALGOL68_LIMITED_STATE; point = algol68_code(matchstart+1,to); break; case '<': // HTML tag search(1, ">"); set_character_color(pos, point, color_class algol68_comment); // debug_position(125,point,"after HTML tag",curchar()); point--; break; } break; case WEB68_ALGOL68_STATE: prev_state = web68_state; /* debug_note(3, "200: curchar='%c'\n", NULL, 0, curchar()); */ point = algol68_code(point, to); break; default: break; } if (point < to) point++; } return point; } algol68_code(from, to) { point = from; to = to; /* debug_note(2,"499: algol68_code(%d, ",NULL,from,'@'); debug_note(2,"%d)\n",NULL,to,'@'); */ while (point < to) { // debug_position(500,point,"algol68_code start",curchar()); switch (curchar()) { case '@': prev_state = web68_state; algol68_token = ALGOL68_TOKEN_WEB68; if (character(point+1) == '>' && web68_state == ALGOL68_LIMITED_STATE ) return point+1; else { point = web68_cmd(point, to); switch (web68_state) { case WEB68_HTML_STATE: return point; // point -> 2nd char of Web 68 cmd case WEB68_ALGOL68_STATE: case ALGOL68_LIMITED_STATE: point++; continue; } } case '!': // monitor(501,"bang"); algol68_token = ALGOL68_TOKEN_BANG; web68_state = WEB68_HTML_STATE; return point; case '"': // monitor(502,"string"); point = algol68_string(point); break; case '$': algol68_token = ALGOL68_TOKEN_FORMAT; point = algol68_format(point); break; case '#': case '{': algol68_token = ALGOL68_TOKEN_COMMENT; // monitor(503,"comment"); point = algol68_comment(point); break; case ' ': case '\t': case '\n': case '\f': /* ignore */ break; case '[': case ']': case '(': case ')': // monitor(504,"bracket"); algol68_token = ALGOL68_TOKEN_BRACKET; set_character_color(point, point+1, color_class algol68_punctuation); break; case '|': // monitor(505,"bar"); algol68_token = ALGOL68_TOKEN_BAR; set_character_color(point, character(point+1) == ':' ? point+1 : point, color_class algol68_mode); break; case ':': point = algol68_operator(point, to); break; case '.': // monitor(507,"number"); point = algol68_number(point, to); break; default: if (isupper(curchar())) { // monitor(510,"bold tag"); point = algol68_bold_tag(point, to); } else if (islower(curchar())) { // monitor(512,"identifier"); point = algol68_identifier(point, to); } else if (isdigit(curchar())) { // monitor(514,"number"); point = algol68_number(point, to); } else if (index(algol68_op_chars, curchar())) { // monitor(516,"operator"); point = algol68_operator(point, to); } else { // monitor(518,"miscellaneous"); set_character_color(point, point+1, color_class algol68_punctuation); } } point++; } return point; } algol68_string(from) { /* from = pos of quote */ algol68_token = ALGOL68_TOKEN_STRING; point = from + 1; // Go just after opening " search(1, "\""); // Move to next ", or else end of buffer set_character_color(from, point, color_class algol68_string); return point-1; } algol68_format(from) { algol68_token = ALGOL68_TOKEN_FORMAT; point = from + 1; // Go just after opening $ search(1, "$"); // Move to next $, or else end of buffer set_character_color(from, point, color_class algol68_string); return point-1; } algol68_comment(from) { /* from = pos of delimiter * to = limit of colouring */ /* Search for the closing delimiter */ algol68_token = ALGOL68_TOKEN_COMMENT; point = from+1; re_search(1, character(from) == '#' ? "#" : "}"); set_character_color(from,point,color_class algol68_comment); return point-1; } algol68_operator(from, to) { // must distinguish between ':=' and ':=:' // curchar() is in algol68_op_chars int pos = from; point = from; to = to; switch (curchar()) { case ':': point++; // curchar() == char following ':' while (index(algol68_colon_chars,curchar())) { point++; pos = point; } if (pos == from) { // sole ':' // monitor(700,"sole colon"); // debug_note(2,"700: algol68_token=%d\n",NULL,algol68_token,'@'); switch(algol68_token) { case ALGOL68_TOKEN_BOLD_TAG: algol68_token = ALGOL68_TOKEN_PUNCTUATION; set_character_color(from,point,color_class algol68_punctuation); break; case ALGOL68_TOKEN_BAR: case ALGOL68_TOKEN_BRACKET: case ALGOL68_TOKEN_NUMBER: case ALGOL68_TOKEN_IDENTIFIER: algol68_token = ALGOL68_TOKEN_CONSTRUCT; set_character_color(from,point,color_class algol68_mode); } return from; // position of ':' } else // ':=', ':/=:', ':=:' switch (pos - from) { // length of string case 2: // ':=' algol68_token = ALGOL68_TOKEN_PUNCTUATION; set_character_color(from,pos,color_class algol68_punctuation); break; default: // ':=:', ':/=:' algol68_token = ALGOL68_TOKEN_CONSTRUCT; set_character_color(from,pos,color_class algol68_mode); } break; default: while (index(algol68_op_chars,curchar())) { point++; pos = point; } // monitor(710,"operator"); algol68_token = ALGOL68_TOKEN_OPERATOR; set_character_color(from, pos, color_class algol68_operator); } return pos-1; } algol68_bold_tag(from, to) { /* from = first upper-case character */ char str[200], tagname[200]; int ms, me; save_var point, matchstart, matchend, case_fold=0; point = from; to = to; algol68_token = ALGOL68_TOKEN_BOLD_TAG; re_search(1, "[A-Z][A-Z0-9]*"); /* Find the extent of the bold tag */ ms = matchstart; me = matchend; grab(matchstart, matchend, tagname); /* Now get the tag in `str' surrounded by | | */ sprintf(str, "|%s|", tagname); /* Now identify the tag */ if (strstr(algol68_construct_pat, str)) { set_character_color(ms, me, color_class algol68_mode); return matchend-1; } if (strstr(algol68_mode_pat, str)) { set_character_color(ms, me, color_class algol68_mode); return matchend-1; } if (strstr(algol68_num_pat, str)) { set_character_color(ms, me, color_class algol68_number); return matchend-1; } if (strstr(algol68_operator_pat, str)) { set_character_color(ms, me, color_class algol68_operator); return matchend-1; } if (strstr(algol68_comment_pat, str)) { set_character_color(ms, me, color_class algol68_mode); point = me; if (search(1, tagname)) { set_character_color(me, matchstart, color_class algol68_comment); set_character_color(matchstart, matchend, color_class algol68_mode); } else { set_character_color(me, point, color_class algol68_comment); } return point-1; } set_character_color(ms, me, color_class algol68_mode); return me-1; } algol68_identifier(from, to) { point = from; to = to; re_search(RE_FORWARD, "[a-z][a-z0-9_ \t]*"); set_character_color(matchstart, matchend, color_class algol68_identifier); return matchend-1; } algol68_number(from, to) { point = from; to = to; re_search(RE_FORWARD, "[0-9a-fr.-+ \t]+"); set_character_color(matchstart,matchend,color_class algol68_number); return matchend-1; } web68_cmd(from, to) { int me; // char module_tag[100]; point = from; switch (size() - point) { case 1: set_character_color(point,point+1,color_class algol68_mode); break; default: // colourise the cmd set_character_color(point,point+2,color_class algol68_mode); point++; // point -> 2nd char. of Web 68 cmd // debug_note(3,"300: web68_cmd 2nd char='%c'\n",NULL,0,curchar()); switch(curchar()) { case '@': case '!': case '\\': case '/': case ',': break; case ' ': case '1': case '2': case '3': // now in HTML mode after a sectioning command web68_state = WEB68_HTML_STATE; break; case 'a': case 'd': case 'm': // now in Algol 68 mode for a macro declaration web68_state = WEB68_ALGOL68_STATE; break; case '.': case '^': case 'h': // HTML code until @> if (search(1, "@>")) { set_character_color(from+2, matchstart, color_class algol68_html); set_character_color(matchstart, matchend, color_class algol68_mode); } else set_character_color(from+2, point, color_class algol68_html); break; case 'i': // Start of an include filename if (search(1, "@>")) { set_character_color(from+2, matchstart, color_class algol68_identifier); set_character_color(matchstart, matchend, color_class algol68_mode); } else set_character_color(from+2, point, color_class algol68_identifier); break; case '<': // Web 68 cmd at the start of a module tag // debug_state(319,web68_state); if (search(1, "@>")) { // after closing tag // grab(from+2,matchstart,module_tag); // get module tag // debug_note(1,"320: module tag='%s'\n",module_tag,0,'@'); /* display the module tag */ if (character(matchend)=='=') me = matchend + 1; else me = matchend; /* check to see whether '=' follows '@>' and * report it debug_position(321, matchend, "character after @>", character(matchend)); */ set_character_color(from+2, matchstart, color_class algol68_string); // tag set_character_color(matchstart,me, color_class algol68_mode); // closing cmd web68_state = WEB68_ALGOL68_STATE; // debug_state(322,web68_state); return me; } else { // search faile, so no closing cmd web68_state = WEB68_HTML_STATE; set_character_color(from, point, color_class algol68_comment); } break; case '=': prev_state = web68_state; web68_state = ALGOL68_LIMITED_STATE; point = algol68_code(point+1, to); web68_state = prev_state; } break; } return point; } command web68_mode() { mode_default_settings(); mode_keys = web68_tab; /* use these keys */ web68_tab[']'] = Matchdelim ? (short) show_matching_delimiter : 0; web68_tab[')'] = Matchdelim ? (short) show_matching_delimiter : 0; web68_tab['}'] = Matchdelim ? (short) show_matching_delimiter : 0; web68_state = WEB68_HTML_STATE; major_mode = strkeep("Web68"); strcpy(comment_start, "(<#|{>)[ \t\f]*"); strcpy(comment_pattern, "#(.|)*#"); strcpy(comment_begin, "#"); strcpy(comment_end, "#"); recolor_range = color_web68_range; /* set up colouring rules */ recolor_from_here = recolor_from_top; coloring_flags = COLOR_INVALIDATE_FORWARD | COLOR_INVALIDATE_RESETS | COLOR_INVALIDATE_BACKWARD; if (want_code_coloring) when_setting_want_code_coloring(); if (auto_show_web68_delimiters) auto_show_matching_characters = web68_auto_show_delim_chars; mode_auto_show_delimiter = web68_auto_show_delimiter; if (web68_tab_override > 0) tab_size = web68_tab_override; try_calling("web68-mode-hook"); drop_all_colored_regions(); make_mode(); } suffix_w68() { compile_buffer_cmd = compile_web68_cmd; web68_mode(); } suffix_w() { web68_mode(); } suffix_t68() { compile_buffer_cmd = compile_web68_cmd; web68_mode(); } suffix_t() { web68_mode(); }