home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
euphor10.zip
/
SYNCOLOR.E
< prev
next >
Wrap
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