Media Share 9/MEDIASHARE_09.ISO/progmisc/euphor10.zip/SYNCOLOR.E

Text File | 1993-06-08 | 5KB | 181 lines

--         Syntax Color
-- These routines are used to display Euphoria program lines
-- in multiple colors. The editor (ed.ex) and the pretty printer (eprint.ex)
-- both include this file.

-- this file assumes that the following symbols have already
-- been defined:
--     SCREEN       - file/device number to write output to
--    BLANK_LINE   - extra blanks to print at end of a line
--      NORMAL_COLOR - colors of various syntax classes
--    COMMENT_COLOR
--    KEYWORD_COLOR
--     BUILTIN_COLOR
--      STRING_COLOR

constant keywords = {
    "if", "end", "then", "procedure", "else", "for", "return",
    "do", "elsif", "while", "type", "constant", "to", "and", "or",
    "exit", "function", "global", "by", "not", "include",
    "with", "without", "profile"}

constant builtins = {
    "length", "puts", "integer", "sequence", "position", "object",
    "append", "prepend", "print", "printf",
    "clear_screen", "floor", "getc", "gets", "get_key",
    "rand", "repeat", "atom", "compare", "find", "match",
    "time", "command_line", "open", "close", "trace",
    "sqrt", "sin", "cos", "tan", "log", "system", "date", "remainder",
    "power", "machine_func", "machine_proc"}

-- character classes
constant DIGIT = 1,
     OTHER = 2,
     LETTER  = 3,
     BRACKET = 4,
     QUOTE   = 5,
     DASH = 6,
     WHITE_SPACE = 7

sequence char_class

global procedure init_class()
-- set up character classes for easier line scanning
-- (assume no 0 char)
    char_class = repeat(OTHER, 255)

    char_class['a'..'z'] = LETTER
    char_class['A'..'Z'] = LETTER
    char_class['_'] = LETTER
    char_class['0'..'9'] = DIGIT
    char_class['['] = BRACKET
    char_class[']'] = BRACKET
    char_class['('] = BRACKET
    char_class[')'] = BRACKET
    char_class['{'] = BRACKET
    char_class['}'] = BRACKET
    char_class['\''] = QUOTE
    char_class['"'] = QUOTE
    char_class[' '] = WHITE_SPACE
    char_class['\t'] = WHITE_SPACE
    char_class['-'] = DASH
end procedure

sequence line  -- the line being processed
integer seg_start, seg_end -- start and end of current segment of line
integer color  -- the current color

procedure flush(integer new_color)
-- if the color is changing, write out the current segment
    if new_color != color then
    if color != -1 then
        text_color(color)
        puts(SCREEN, line[seg_start..seg_end])
        seg_start = seg_end + 1
    end if
    color = new_color
    end if
end procedure

global procedure DisplayColorLine(sequence pline, integer all_clear)
-- Display a line with colors identifying the various
-- parts of the Euphoria language.
-- Each screen write has a lot of overhead, so we try to minimize
-- the number of them by collecting consecutive characters of the
-- same color into a 'segment' seg_start..seg_end.

    integer class, last, i, c, bracket_level
    sequence word

    line = pline
    color = -1 -- initially undefined
    bracket_level = 0
    seg_start = 1
    seg_end = 0
    while seg_end < length(line) do
    c = line[seg_end+1]
    class = char_class[c]

    if class = WHITE_SPACE then
        seg_end = seg_end + 1 -- continue with same color

    elsif class = LETTER then
        last = length(line)
        for j = seg_end + 2 to last do
        c = line[j]
        class = char_class[c]
        if class != LETTER then
            if class != DIGIT then
            last = j - 1
            exit
            end if
        end if
        end for
        word = line[seg_end+1..last]
        if find(word, keywords) then
        flush(KEYWORD_COLOR)
        elsif find(word, builtins) then
        flush(BUILTIN_COLOR)
        else
        flush(NORMAL_COLOR)
        end if
        seg_end = last

    elsif class <= OTHER then -- DIGIT too
        flush(NORMAL_COLOR)
        seg_end = seg_end + 1

    elsif class = BRACKET then
        if find(c, "([{") then
        bracket_level = bracket_level + 1
        end if
        if bracket_level >= 1 and
           bracket_level <= length(bracket_color) then
        flush(bracket_color[bracket_level])
        else
        flush(NORMAL_COLOR)
        end if
        if find(c, ")]}") then
        bracket_level = bracket_level - 1
        end if
        seg_end = seg_end + 1

    elsif class = DASH then
        if seg_end + 2 <= length(line) then
        if line[seg_end+2] = '-' then
            flush(COMMENT_COLOR)
            seg_end = length(line)
            exit
        end if
        end if
        flush(NORMAL_COLOR)
        seg_end = seg_end + 1

    else  -- QUOTE
        i = seg_end + 2
        while i <= length(line) do
        if line[i] = c then
            if line[i-1] != '\\' then
            i = i + 1
            exit
            end if
        end if
        i = i + 1
        end while
        flush(STRING_COLOR)
        seg_end = i - 1
    end if
    end while

    if color != -1 then
    text_color(color)
    end if
    if all_clear then
    puts(SCREEN, line[seg_start..seg_end])
    else
    puts(SCREEN, line[seg_start..seg_end] & BLANK_LINE)
    end if
end procedure