## parse-resource-specs.pkg
# Compiled by:
# src/lib/x-kit/style/xkit-style.sublib# Support for parsing X11 format resource specifications.
# "The time to begin writing an article is when
# you have finished it to your satisfaction.
# By that time you begin to clearly and logically
# perceive what it is that you really want to say."
#
# - Mark Twain's Notebook, 1902-1903
package parse_resource_specs: (weak) api {
Comp_Name = quark::Quark;
Name = quark::Quark;
Component = WILD | NAME Comp_Name;
# A component is either "?" or a component name
Naming = TIGHT | LOOSE;
Resource_Spec
= NO_SPEC # Comment or blank line
| INCL String # "#include" directive
| RSRC_SPEC {
loose: Bool, # TRUE, if the spec has a leading "*"
path: List( (Component, Naming) ),
attribute: Name, # the attribute name
value: String, # the value
ext: Bool # TRUE, if the value extends onto the
# next line
};
# This exception is raised, if the specification is ill-formed.
# The integer argument is the character position of the error.
#
exception BAD_SPECIFICATION Int;
parse_rsrc_spec: String -> Resource_Spec;
#
# Decompose a resource specification string into a list
# of (component, naming) pairs, an attribute name, and
# an attribute value.
parse_value_ext: String -> ((String, Bool));
#
# Parse a value extension, returning the extension and a boolean flag
# that will be TRUE if there is a further extension of the value.
parse_style_name: String -> List( Comp_Name );
#
# Check and decompose a style name, which has the format:
#
# <StyleName> ::= <ComponentName> ("." <ComponentName>)*
check_comp_name: String -> Comp_Name;
#
# Check a component name.
check_attribute_name: String -> Name;
#
# Check an attribute name.
}
{
package ss= substring; # substring is from src/lib/std/substring.pkg max_char = 255;
Char_Ilk
= COMMENT # "!"
| DIRECTIVE # "#"
| TIGHT_BIND # "."
| LOOSE_BIND # "*"
| WILD_COMP # "?"
| SPACE # space or tab
| COLON # ":"
| NAME_CHAR # "A"-"Z", "a"-"z", "0"-"9", "-", "_"
| EOL # newline
| ESCAPE # "\"
| NON_PRT # other non-printing characters
| OTHER; # other printing characters
# This table maps character ordinals to character ilks
#
cc_map
=
char_map::make_char_map {
default => NON_PRT,
namings => [
("!", COMMENT),
("#", DIRECTIVE),
(".", TIGHT_BIND),
("*", LOOSE_BIND),
("?", WILD_COMP),
(" \t", SPACE),
(":", COLON),
("ABCDEFGHIJKLMNOPQRSTUVWXYZ\
\abcdefghijklmnopqrstuvwxyz\
\0123456789-_", NAME_CHAR),
("\n", EOL),
("\\", ESCAPE),
("\"$%&'()+,/;<=>@[]^`{|}~", OTHER)
]
};
map_char = char_map::map_string_char cc_map;
# Get the ilk of the i'th character of a string
#
fun get_cc (s, i)
=
if (i < size s) map_char (s, i); else EOL; fi;
# Skip white space:
#
fun skip_ws (s, i)
=
if (get_cc (s, i) == SPACE) skip_ws (s, i+1);
else i;
fi;
Comp_Name = quark::Quark;
Name = quark::Quark;
Component = WILD | NAME Comp_Name;
Naming = TIGHT | LOOSE;
Resource_Spec
= NO_SPEC # Comment or blank line
| INCL String # "#include" directive
| RSRC_SPEC {
loose: Bool, # TRUE, if the spec has a leading "*"
path: List( (Component, Naming) ),
attribute: Name, # the attribute name
value: String, # the value
ext: Bool # TRUE, if the value extends onto the
# next line
};
# This exception is raised if the specification is ill-formed.
# The integer argument is the character position of the error.
#
exception BAD_SPECIFICATION Int;
# Scan a component
#
fun scan_comp (s, i)
=
case (get_cc (s, i))
WILD_COMP => (WILD, i+1);
NAME_CHAR
=>
{ fun scan j
=
case (get_cc (s, j))
NAME_CHAR => scan (j+1);
_ => j-i;
esac;
len = scan (i+1);
(NAME (quark::quark (substring (s, i, len))), i+len);
};
_ => raise exception (BAD_SPECIFICATION i);
esac;
# Scan a naming, which is a sequence of one or more "." and "*" characters.
# If any character in the naming is "*", then it is a loose naming,
# otherwise it is a TIGHT naming.
#
fun scan_naming (s, i)
=
{ fun scan (s, i, bind)
=
case (get_cc (s, i))
LOOSE_BIND => scan (s, i+1, LOOSE);
TIGHT_BIND => scan (s, i+1, bind);
_ => (bind, i);
esac;
case (get_cc (s, i))
LOOSE_BIND => scan (s, i+1, LOOSE);
TIGHT_BIND => scan (s, i+1, TIGHT);
_ => raise exception BAD_SPECIFICATION i;
esac;
};
# Scan a value, returning it as a string with a boolean extension
# flag. This recognizes and converts escape sequences as follows:
#
# \<space> ==> a space character
# \<tab> ==> a tab character
# \\ ==> a backslash character
# \n ==> a newline character
# \<newline> ==> ignore the newline; if the newline is the last
# character in the string, then the extension flag
# is TRUE.
# \ddd ==> convert octal digits to character code.
#
fun scan_value (s, i)
=
{ fun get_octal ss
=
{ scan = int::scan number_string::OCTAL ss::getc;
fun is_oct c
=
('0' <= c) and (c < '8');
my (oct, rest) = ss::split_at (ss, 3);
if (is_oct (ss::get (oct, 0)))
#
case (scan oct)
#
THE (n, r)
=>
if (ss::is_empty r)
#
(string::from_char (char::from_int n), rest);
else
raise exception BAD_SPECIFICATION i;
fi;
NULL => raise exception BAD_SPECIFICATION i;
esac;
else
raise exception BAD_SPECIFICATION i;
fi;
}
except
_ = raise exception BAD_SPECIFICATION i;
fun finish (prefix, chunks)
=
ss::cat (list::reverse (prefix ! chunks));
fun scan (ss, chunks)
=
{ my (prefix, rest)
=
ss::split_off_prefix
\\ ('\\' | '\n') => FALSE;
_ => TRUE;
end
ss;
fun add (c, rest)
=
scan (rest, (ss::from_string c) ! prefix ! chunks);
case (ss::getc rest)
#
NULL => (finish (prefix, chunks), FALSE);
#
THE ('\n', rest) => (finish (prefix, chunks), FALSE);
THE (_, rest)
=>
case (ss::getc rest)
#
NULL => (finish (prefix, chunks), TRUE);
THE('\t', rest) => add("\t", rest);
THE(' ', rest) => add(" ", rest);
THE('\\', rest) => add("\\", rest);
THE('\n', rest)
=>
case (ss::getc rest)
THE _ => scan (rest, prefix ! chunks);
NULL => (finish (prefix, chunks), TRUE);
esac;
THE('n', rest) => add("\n", rest);
THE _ => add (get_octal rest);
esac;
esac;
};
scan (ss::drop_first i (ss::from_string s), []);
};
# Decompose a resource specification string into a list
# of (component, naming) pairs, an attribute name, and
# an attribute value.
#
fun parse_rsrc_spec ln
=
{ start = skip_ws (ln, 0);
fun get_comp_bind (i, path)
=
{ my (comp, i) = scan_comp (ln, i);
fun get_rest i
=
case comp
#
NAME attribute => (reverse path, attribute, skip_ws (ln, i+1));
WILD => raise exception (BAD_SPECIFICATION i);
esac;
case (get_cc (ln, i))
#
COLON => get_rest i;
#
SPACE
=>
{ i = skip_ws (ln, i+1);
case (get_cc (ln, i))
COLON => get_rest i;
_ => raise exception (BAD_SPECIFICATION i);
esac;
};
_ =>
{ my (bind, i) = scan_naming (ln, i);
get_comp_bind (i, (comp, bind) ! path);
};
esac;
};
case (get_cc (ln, start))
#
(EOL | COMMENT) => NO_SPEC;
#
DIRECTIVE => NO_SPEC; # fix
#
(WILD_COMP | NAME_CHAR)
=>
{ my (path, attribute_name, val_start)
=
get_comp_bind (start, []);
my (value, ext)
=
scan_value (ln, val_start);
RSRC_SPEC {
loose => FALSE, path,
attribute => attribute_name, value,
ext
};
};
LOOSE_BIND
=>
{ my (path, attribute_name, val_start)
=
get_comp_bind (start+1, []);
my (value, ext)
=
scan_value (ln, val_start);
RSRC_SPEC {
loose => TRUE, path,
attribute => attribute_name, value,
ext
};
};
_ => raise exception (BAD_SPECIFICATION start);
esac;
}; # fun parse_rsrc_spec
# Parse a value extension, returning the extension and a boolean flag
# that will be TRUE if there is a further extension of the value.
fun parse_value_ext ln
=
scan_value (ln, 0);
# Check and decompose a style name, which has the format:
#
# <StyleName> ::= <ComponentName> ("." <ComponentName>)*
#
fun parse_style_name s
=
{ len = size s;
fun scan_comp_name i
=
case (scan_comp (s, i))
(NAME name, j) => (name, j);
_ => raise exception (BAD_SPECIFICATION i);
esac;
fun scan (i, comps)
=
if (i < len)
case ( map_char (s, i))
TIGHT_BIND
=>
{ my (name, i) = scan_comp_name (i+1);
scan (i, name ! comps);
};
_ => raise exception (BAD_SPECIFICATION i);
esac;
else
reverse comps;
fi;
my (name, i) = scan_comp_name 0;
scan (i, [name]);
};
# Check a component name:
#
fun check_comp_name str
=
case (scan_comp (str, 0))
(NAME name, _) => name;
_ => raise exception (BAD_SPECIFICATION 0);
esac;
# Check an attribute name:
#
check_attribute_name = check_comp_name;
}; # package parse_resource_specs