DIRECTORY
ColorizeViewPoint, ColorizeViewPointBackdoor, ProfilesBackdoor, ProfilesPrivate, ImagerFont, IO, Profiles, Rope, SymTab;
Utilities
SubpaletteSearchList:
PUBLIC
PROC [prefixesIn:
LIST
OF
ROPE, profile: Profiles.Profile]
RETURNS [allPrefixes:
LIST
OF
ROPE ←
NIL] ~ {
--makes a correctly ordered, unduplicated list of prefixes, including the custom palette, Colorization-specific prefixesIn listed by, eg, "TextPrefix", document-wide prefixes listed in profile, and the "Default" palette
NotDuplicated:
PROC [toCheck:
ROPE]
RETURNS [
BOOL] ~ {
IF toCheck=NIL THEN RETURN [FALSE];
FOR each:
LIST
OF
ROPE ← dummyHead.rest, each.rest
UNTIL each=
NIL
DO
IF each.first.Equal[s2: toCheck, case: FALSE] THEN RETURN [FALSE];--duplicate
ENDLOOP;
RETURN [TRUE]; --not duplicated
};
dummyHead: LIST OF ROPE ← LIST[NIL]; --mechanism to add elements to end of a list
tail: LIST OF ROPE ← dummyHead;
docPrefixes: LIST OF ROPE ~ Profiles.ListOfTokens[profile: profile, key: "Palette"];
defaultPalettePrefix: ROPE ~ Profiles.Token[profile: profile, key: "DefaultPalettePrefix", default: "Default"]; --the correct prefix for the default palette
1. Search the custom palette (marked by "!")
tail ← (tail.rest ← LIST["!"]);
2. Then just search for the keyName directly (no prefix); found only in Custom palette
tail ← (tail.rest ← LIST[""]);
3. Then check the subpalettes specially requested in this case
FOR each:
LIST
OF
ROPE ← prefixesIn, each.rest
UNTIL each=
NIL
DO
IF NotDuplicated[each.first] THEN tail ← (tail.rest ← LIST[each.first]);
ENDLOOP;
4. Then check the document-wide subpalettes requested in the Custom palette
FOR each:
LIST
OF
ROPE ← docPrefixes, each.rest
UNTIL each=
NIL
DO
IF NotDuplicated[each.first] THEN tail ← (tail.rest ← LIST[each.first]);
ENDLOOP;
5. Finally, search the Default palette
IF NotDuplicated[defaultPalettePrefix] THEN tail ← (tail.rest ← LIST[defaultPalettePrefix]);
RETURN [dummyHead.rest];
};
CleanupUserCommands:
PUBLIC
PROC [commands:
ROPE, palette: Profiles.Profile]
RETURNS [cleanCommands:
ROPE] ~ {
--cleans up the Custom Colors commands found both in the document CustomColorsPage and in the rope slices handed into ColorizeViewPoint.Do (like printer messages).
IF commands=NIL THEN RETURN [NIL];
cleanCommands ←
ZapSpacesBeforeColon[ FindOrphanLines[ EliminateComments[ ModifyXCharStream[commands]]]];
cleanCommands ← LookupValAndMark[cleanCommands, palette];
};
ModifyXCharStream:
PROC [old:
ROPE]
RETURNS [new:
ROPE] ~ {
--Scans for extended character codes: translates ViewPoint's hyphen into '-; adds spaces around some chars
AddSpace:
PROC [] ~ {
IO.PutChar[self: modifiedStream, char: ' ]; --Ascii.SP
};
TranslateXChars: ImagerFont.XCharProc ~ {
PROC [char: ImagerFont.XChar]
SELECT
TRUE
FROM
char.set=0 => {
c: CHAR ~ LOOPHOLE[char.code];
SELECT c
FROM
'[, '], '{, '}, '(, '), ',, ';, '+, '&, '| => {AddSpace[]; IO.PutChar[self: modifiedStream, char: c]; AddSpace[]};
': => { IO.PutChar[self: modifiedStream, char: c]; AddSpace[]}; --space after colon
ENDCASE => IO.PutChar[self: modifiedStream, char: c];
};
char=[41B,76B] --VP hyphen-- => IO.PutChar[self: modifiedStream, char: '-];
ENDCASE => SIGNAL Warning[$MalformedPaletteEntry, IO.PutFR[format: "Unrecognized character [%g, %g] in profile entry.", v1: [cardinal[char.set]], v2: [cardinal[char.code]]]];
};
modifiedStream: IO.STREAM ~ IO.ROS[];
ImagerFont.MapRope[rope: old, charAction: TranslateXChars]; --maps old into modifiedStream
RETURN [modifiedStream.RopeFromROS[]];
};
EliminateComments:
PROC [old:
ROPE]
RETURNS [new:
ROPE ←
NIL] ~ {
--Remove comments so as not to interfere with FindOrphanLines below, which can merge comment lines together when they shouldn't be
flushedTo, commentPos, endCommentPos: INT ← 0;
oldLength: INT = old.Size[];
UNTIL commentPos=oldLength
DO
commentPos ←
MIN[
Rope.Index[s1: old, pos1: flushedTo, s2: "--"],
Rope.Index[s1: old, pos1: flushedTo, s2: "<<"]
];
IF commentPos<oldLength
THEN
SELECT Rope.Fetch[base: old, index: commentPos]
FROM
'- => {
endCommentPos ←
MIN[
oldLength,
Rope.Index[s1: old, pos1: commentPos+2, s2: "--"]+2,
Rope.Index[s1: old, pos1: commentPos+2, s2: "\r"],
Rope.Index[s1: old, pos1: commentPos+2, s2: "\l"],
Rope.Index[s1: old, pos1: commentPos+2, s2: "\f"]
]; --have to look for \r (return) and \l (linefeed) specifically instead of \n, because systems interpret \n differently (Unix calls it \012 - a linefeed!) \f is inserted by ObtainEmbeddedProfile as a hard endline char
};
'< => {
--Deal with nested angle comments
nestLevel: NAT ← 1;
endCommentPos ← commentPos+2;
WHILE nestLevel>0
DO
up: INT ~ Rope.Index[s1: old, pos1: endCommentPos, s2: "<<"];
dn: INT ~ Rope.Index[s1: old, pos1: endCommentPos, s2: ">>"];
IF dn<up THEN nestLevel ← nestLevel-1;
endCommentPos ← MIN[oldLength, dn+2];
ENDLOOP;
};
ENDCASE => ERROR; --System error
IF commentPos<oldLength
THEN {
};
new ← new.Cat[old.Substr[start: flushedTo, len: commentPos-flushedTo]];
flushedTo ← endCommentPos;
ENDLOOP;
};
FindOrphanLines:
PROC [old:
ROPE]
RETURNS [new:
ROPE ←
NIL] ~ {
--long ViewPoint lines get mapped erroneously by ObtainEmbeddedProfile into multiple lines. To correct, look for *\n, where * has no ': in it (ie, is not a complete profile definition), and combine. Break no matter what on *\f, since ObtainEmbeddedProfile puts in \f if it senses a bigger than normal jump btwn the 2 lines, eg for a footer.
oldSize: INT ~ old.Size;
flushedTo, break, colon: INT ← 0; --points to beginning of old, or a newline character
replace: ROPE;
UNTIL flushedTo>oldSize
DO
break ← MIN[Rope.Index[s1: old, pos1: flushedTo, s2: "\r"], Rope.Index[s1: old, pos1: flushedTo, s2: "\l"], Rope.Index[s1: old, pos1: flushedTo, s2: "\f"]]; --again, \n is broken down into its two interpretations by diff systems: \l or \r
colon ← Rope.Index[s1: old, pos1: flushedTo, s2: ":"];
replace ←
SELECT
TRUE
FROM
old.Fetch[MAX[0, flushedTo-1]]='\f--hard break--, colon<break--colon in line-- => "\n",
ENDCASE => " "; --turn break into space to merge line w/ previous line
new ← new.Cat[replace, old.Substr[start: flushedTo, len: break-flushedTo]];
flushedTo ← break+1; --just past the break char
ENDLOOP;
};
ZapSpacesBeforeColon:
PROC [old:
ROPE]
RETURNS [new:
ROPE ←
NIL] ~ {
--a Profile key (before the colon) should have no spaces, but users should be able to use spaces in their embedded profiles
flushedTo: INT ← 0;
UNTIL flushedTo
>old.Size[]
DO
colonPos: INT ~ Rope.Index[s1: old, pos1: flushedTo, s2: ":"];
newLinePos: INT ~ MIN[Rope.Index[s1: old, pos1: flushedTo, s2: "\r"], Rope.Index[s1: old, pos1: flushedTo, s2: "\l"]];
spacePos: INT ~ Rope.Index[s1: old, pos1: flushedTo, s2: " "];
IF spacePos<colonPos
AND newLinePos>colonPos
--takes care of initial \n--
THEN {
new ← new.Concat[old.Substr[start: flushedTo, len: spacePos-flushedTo]];
flushedTo ← spacePos+1; --to skip the space
}
ELSE {
new ← new.Concat[old.Substr[start: flushedTo, len: (newLinePos+1)-flushedTo]];
flushedTo ← newLinePos+1; --to skip the whole line
};
ENDLOOP;
};
LookupValAndMark:
PROC [old:
ROPE, palette: Profiles.Profile]
RETURNS [new:
ROPE] ~ {
-- some tokens are written wrong and must be changed. Eg, numbered colors like C24 may also be written as C024 or c0024 and won't be found; the keyword "Unchanged" must be changed to "ForceToNone" (ie, no palette) to be processed correctly as an exception command. Change them. Also, mark named colors with "!", because unless AmbushAllYESColors is set, you only want to deal with the namedcolors redefined in the Custom palette, and this lets you find them.
EachLine: LineProcessor ~ {
--(line will match "*:*" (all valid lines)).
PROC [line, in: ROPE] RETURNS [newLine: ROPE ← NIL]
colonPos: INT ← line.Find[":"];
token: Token ← ParseToken[value: line.Substr[0, colonPos], palette: palette];
SELECT token.type
FROM
namedColor => newLine ← Rope.Cat["!", token.prefix, token.lookupVal, line.Substr[colonPos]];
ENDCASE => IF token.lookupVal.Equal[s2: "Unchanged", case: FALSE] THEN newLine ← Rope.Concat["ForceToNone", line.Substr[colonPos]] ELSE newLine ← Rope.Cat[token.prefix, token.lookupVal, line.Substr[colonPos]];
};
new ← ProcessLinesMatching["*:*", old, EachLine];
};
ProcessLinesMatching:
PUBLIC PROC [pattern, in:
ROPE, lineProcessor: LineProcessor]
RETURNS [new:
ROPE]~ {
--finds lines in "in" that match pattern and hands each line (and "in") to lineProcessor. lineProcessor hands back a newLine if it changed it, otherwise NIL.
start, end: INT ← 0;
line, newLine: ROPE ← NIL;
WHILE end<in.Length
DO
start ← end;
end ← MIN[in.Index[pos1: start, s2: "\r"], in.Index[pos1: start, s2: "\l"]]+1;
line ← in.Substr[start, end-start];
IF Rope.Match[pattern: pattern, object: line, case:
FALSE]
THEN {
newLine ← lineProcessor[line, in];
IF newLine#
NIL THEN {
in ← in.Replace[start: start, len: end-start, with: newLine];
end ← start+newLine.Length;
};
};
ENDLOOP;
new ← in; --"in" has been processed by lineProcessor
};
Interacting With Palette Entries
SetProfileBoolean:
PUBLIC
PROC [profile: Profiles.Profile, key:
ROPE, val:
BOOL] ~ {
--Requires knowledge of internal structure of Profile
curEntry: ProfilesBackdoor.ProfileEntry ← ProfilesBackdoor.Lookup[profile: profile, key: key];
IF curEntry#
NIL
THEN
TRUSTED {
profilePrivate: ProfilesPrivate.Profile ← LOOPHOLE[profile];--to be able to get at internal structure
curEntry.tokens.first ← IF val THEN "TRUE" ELSE "FALSE";
[] ← SymTab.Store[x: profilePrivate.entries, key: key, val: curEntry];
};
};
maxLevels: INT ← 4; --should be enough recursion for well-formed color defs
GetRecursiveValue:
PUBLIC
PROC [key:
ROPE, palette: Profiles.Profile, subpaletteList:
LIST
OF
ROPE, mapData: MapData, levelsAllowed:
INT ←
INT.
FIRST, customOnly, noMappings:
BOOL ←
FALSE]
RETURNS [value:
LIST
OF
ROPE ←
NIL, levelsExceeded:
BOOL ←
FALSE] ~ {
GetValueInternal:
PROC [key: Token, level:
INT ← 0]
RETURNS [value:
LIST
OF
ROPE ←
NIL, levelsExceeded:
BOOL ←
FALSE] ~ {
AddToEnd: PROC [] ~ INLINE { FOR each: LIST OF ROPE ← value, each.rest UNTIL each=NIL DO tail ← (tail.rest ← LIST[each.first]); ENDLOOP};
SearchSubpalettes:
PROC [key: Token, searchList:
LIST
OF
ROPE]
RETURNS [rawLine:
ROPE ←
NIL] ~ {
--checks Mappings first then looks thru subpaletteList
IF ~noMappings
THEN
--find colors defined as exceptions ("ForceToRed: c1, c17")
IF (rawLine ← ApplyMappings[toMap: keyName, palette: palette, mapData: mapData].mappedRope)#NIL THEN RETURN;
FOR each:
LIST
OF
ROPE ← searchList, each.rest
UNTIL each=
NIL
DO
--search all subpal's
IF (rawLine ← Profiles.Line[profile: palette, key: Rope.Concat[each.first, keyName]])#NIL THEN RETURN;
ENDLOOP;
IF key.prefix#
NIL
THEN {
--as a last attempt, assume the prefix is a mapping. Finds colors like "Springc69" by applying mapping "Spring" to "c69"
keyName ← key.lookupVal; --strip off prefix to use as mapping
RETURN [Rope.Concat["ForceTo", key.prefix]]; --handled by GetTokenRecursively
};
};
GetTokenRecursively:
PROC [token: Token, level:
INT]
RETURNS [value:
LIST OF ROPE ←
NIL, levelsExceeded:
BOOL ←
FALSE] ~ {
--
recursively checks palette down to levelsAllowed recursion levels
SELECT token.type
FROM
namedColor, keyword =>
[value, levelsExceeded] ← GetValueInternal[token, level+1];
pattern, numberedColor, other => {
lookUp: ROPE ← Rope.Concat[token.prefix, token.lookupVal];
SELECT
TRUE
FROM
token.lookupVal.Equal[s2: "Unchanged", case: FALSE] => RETURN; --if keyword "Unchanged" found, return NIL to ensure color unchanged
Rope.Match[pattern: "ForceTo*", object: lookUp, case: FALSE] => RETURN [ApplyMappings[toMap: keyName, palette: palette, mapData: mapData, mapOnly: lookUp.Substr[7--after "ForceTo"--], subpaletteList: subpaletteList].mappedList, FALSE]; --map the token with the specified mapping
ENDCASE => [value, levelsExceeded] ← GetValueInternal[token, level+1];
};
ENDCASE --ipFrag, sepr, number-- => RETURN [LIST[token.lookupVal], FALSE]; --just return the token itself
};
dummyHead: LIST OF ROPE ← LIST[NIL]; --mechanism to add elements to end of a list
tail: LIST OF ROPE ← dummyHead;
line: LIST OF Token;
levelsEverExceeded: BOOL ← FALSE;
keyName: ROPE ← Rope.Concat[key.prefix, key.lookupVal];
IF level>levelsAllowed THEN RETURN [LIST[keyName], TRUE];
IF (line ← ParseLine[SearchSubpalettes[key: key, searchList: (IF customOnly AND level=0 THEN LIST["!"] ELSE subpaletteList)], palette])=NIL THEN RETURN [(IF level=0 THEN NIL --NIL on level 0 says that key was not in palette at all-- ELSE LIST[keyName]), FALSE]; --if customOnly, look only in the custom palette ("!") for the level 0 search
FOR each:
LIST
OF Token ← line, each.rest
UNTIL each=
NIL
DO
[value, levelsExceeded] ← GetTokenRecursively[token: each.first, level: level];
IF levelsExceeded THEN levelsEverExceeded ← TRUE;
AddToEnd[]; --add value list to end of main list one at a time
ENDLOOP;
RETURN[dummyHead.rest, levelsEverExceeded];
};
IF levelsAllowed=INT.FIRST THEN levelsAllowed ← maxLevels;
[value, levelsExceeded] ← GetValueInternal[ParseToken[value: key, palette: palette], 0];
IF value#
NIL
THEN {
value ← CheckForRemoveAndSweep[value]; --checks thru value to eliminate the words "Sweep*" and "Remove*"; this allows layering of two colors both defined as Sweeps, eg: if C17 is "Sweep C1 - C5" & C18 is "Sweep C6 - C7", this allows: "C19: C17, C18 Remove" for a 2-dimensional sweep even though there is an extra "Sweep" word
RETURN [(IF ~noMappings THEN ApplyMappings[value, palette, mapData].mappedList ELSE value), levelsExceeded];
};
};
CheckForRemoveAndSweep:
PROC [value:
LIST
OF
ROPE]
RETURNS [newValue:
LIST
OF
ROPE ←
NIL] ~ {
--removes extra "Remove" & "Sweep" words
dummyHead: LIST OF ROPE ← LIST[NIL]; --mechanism to add elements to end of a list
tail: LIST OF ROPE ← dummyHead;
sweepFound, removeFound: BOOL ← FALSE; --keep first "Sweep" & "Remove" only, but a separator (other than '- & ', ) separates colors and resets
FOR each:
LIST
OF
ROPE ← value, each.rest
UNTIL each=
NIL
DO
SELECT each.first.Fetch
FROM
'R, 'r =>
--might be "Remove*"
IF Rope.Match[pattern: "Remove*", object: each.first, case:
FALSE]
THEN
{IF ~removeFound THEN {removeFound ← TRUE; tail ← (tail.rest ← LIST[each.first])}}
ELSE --some other token starting with "R"-- tail ← (tail.rest ← LIST[each.first]);
'S, 'r =>
--might be "Sweep*"
IF Rope.Match[pattern: "Sweep*", object: each.first, case:
FALSE]
THEN
{IF ~sweepFound THEN {sweepFound ← TRUE; tail ← (tail.rest ← LIST[each.first])}} --Still can use a subpalette called "Sweeps" or "Sweep" without tripping, because by this time value is only keywords and numbers.
ELSE --some other token starting with "S"-- tail ← (tail.rest ← LIST[each.first]);
'; , '&, '| , '[, '], '(, ') =>
--reset on separators
{sweepFound ← removeFound ← FALSE; tail ← (tail.rest ← LIST[each.first])};
ENDCASE => tail ← (tail.rest ← LIST[each.first]);--add to end of newValue
ENDLOOP;
RETURN [dummyHead.rest];
};
TokenType: TYPE ~{ipFrag, sepr, number, pattern, numberedColor, namedColor, keyword, other};
Token: TYPE ~ REF TokenRep;
TokenRep: TYPE ~ RECORD [lookupVal: ROPE--token c04 => lookupVal "c4"--, prefix: ROPE ← NIL--eg "Spring" in "SpringC12"--, spaceBefore: ROPE ← " " --but some will have space NIL--, type: TokenType];
ParseLine:
PROC [line:
ROPE, palette: Profiles.Profile]
RETURNS [tokenList:
LIST
OF Token ←
NIL] ~ {
CheckIfSweep:
PROC [] ~ {
--a pesky problem. Sweep-90 is allowed, so in that one case the dash should be added as part of the token
SpaceBreak: IO.BreakProc ~ {RETURN [SELECT char FROM IN [IO.NUL .. IO.SP], '\t => break, ENDCASE => other]};
IF ~(parsedToken.lookupVal.Equal[s2: "Sweep", case: FALSE]) THEN RETURN;
SELECT
IO.PeekChar[inStream]
FROM
'- => {tag:
ROPE ←
IO.GetTokenRope[stream: inStream, breakProc: SpaceBreak].token;
parsedToken.lookupVal ← Rope.Concat[parsedToken.lookupVal, tag]};
ENDCASE => RETURN;
};
AddToEnd:
PROC [add:
ROPE, to:
LIST
OF
ROPE]
RETURNS [new:
LIST
OF
ROPE] ~ {
IF to=NIL THEN RETURN [LIST[add]] ELSE RETURN [CONS[to.first,AddToEnd[add, to.rest]]];
};
AddPrevTokens:
PROC [] ~ {
trialTok: ROPE ← NIL;
FOR each:
LIST
OF
ROPE ← previousTokList, each.rest
UNTIL each=
NIL
DO
trialTok ← Rope.Concat[trialTok, each.first];
IF ParseToken[trialTok, 0, palette].type=namedColor THEN previousTokList ← CONS[trialTok, each.rest]; --find the largest aggregate that creates a namedColor
ENDLOOP;
FOR each:
LIST
OF
ROPE ← previousTokList
--changed--, each.rest
UNTIL each=
NIL
DO
tail ← (tail.rest ← LIST[ParseToken[each.first, 1--insert space--, palette]]);
ENDLOOP;
};
TokenBreak:
IO.BreakProc ~ {
[char: CHAR] RETURNS [IO.CharClass]
RETURN [
SELECT char
FROM
':, '\n, '\r, '\l, '-, ',, ';, '[, '], '{, '}, '(, '), '<, '>, '+, '=, '&, '| => break,
IN [IO.NUL .. IO.SP], '\t => sepr,
ENDCASE => other]; --includes ".", so eg "Underline.DropShadowOffset" is treated correctly, as a "noPrefixColorKey", and so numbers are not broken ("1.0")
};
inStream: IO.STREAM ~ IO.RIS[rope: line];
previousTokList: LIST OF ROPE ← NIL;
charsSkipped: INT ← 0;
dummyHead: LIST OF Token ← LIST[NIL]; --mechanism to add elements to end of a list
tail: LIST OF Token ← dummyHead;
parsedToken: Token;
IF line=NIL THEN RETURN;
DO
token: ROPE;
[token, charsSkipped] ← IO.GetTokenRope[stream: inStream, breakProc: TokenBreak ! IO.EndOfStream => EXIT];
parsedToken ← ParseToken[token, charsSkipped, palette];
IF parsedToken.type=keyword THEN CheckIfSweep[! IO.EndOfStream => EXIT];
SELECT
TRUE
FROM
parsedToken.type=ipFrag => RETURN[LIST[parsedToken, NEW [TokenRep ← [lookupVal: line.Substr[7--after "IPFrag "--], spaceBefore: NIL, type: ipFrag]]]]; --return exactly what is written w/o processing, since IP frags can have weird chars
parsedToken.type=other OR parsedToken.type=namedColor => previousTokList ← AddToEnd[token, previousTokList]; --could be a multi-word namedColor; add and eval later
previousTokList=NIL => tail ← (tail.rest ← LIST[parsedToken]); --add to end of list
ENDCASE
--previousTokList#
NIL
AND parsedToken.type#other or namedColor, so time to eval previousTokList and add both to list-- => {
AddPrevTokens[];
tail ← (tail.rest ← LIST[parsedToken]);
previousTokList ← NIL;
};
ENDLOOP;
IF previousTokList#NIL THEN AddPrevTokens[];
RETURN [dummyHead.rest];
};
ParseToken:
PROC [value:
ROPE, charsSkipped:
INT ← 0, palette: Profiles.Profile]
RETURNS [token: Token] ~ {
IsIPFrag:
PROC []
RETURNS [
BOOL] ~ {
--allows palette to contain specific ipFrag, tagged with the initial keyword IPFrag.
Dangerous!!
IF value.Equal["IPFrag"] THEN {token.type ← ipFrag; RETURN [TRUE]} ELSE RETURN [FALSE]; --not an ipFrag
};
IsSeparator:
PROC []
RETURNS [
BOOL] ~ {
SELECT value.Fetch
FROM
':, '\n, '\r, '\l, '-, ',, ';, '[, '], '{, '}, '(, '), '<, '>, '+, '=, '&, '| => {token.type ← sepr; RETURN [TRUE]};
ENDCASE => RETURN [FALSE]; --not a separator
};
IsNumber:
PROC []
RETURNS [
BOOL] ~ {
--looking for eg ".75"; but will also pass "0.75.6"
FOR i:
INT
IN [0..valueLength)
DO
SELECT value.Fetch[i]
FROM
IN ['0..'9], '. => LOOP;
ENDCASE => RETURN [FALSE]; --not a number
ENDLOOP;
token.type ← number;
RETURN [TRUE];
};
IsPattern:
PROC []
RETURNS [
BOOL] ~ {
--is it a pattern? Look for "[0..9]%"
NumbersTilBeginning:
PROC [index:
INT]
RETURNS [{all, some, none}] ~ {
IF ~(value.Fetch[index ← index-1] IN ['0..'9]) THEN RETURN [none]; --no "." allowed
FOR i:
INT
DECREASING IN [0..index]
DO
--looking for eg "Prefix25%AE"
IF ~(value.Fetch[i] IN ['0..'9]) THEN {prefixEnd ← i+1; RETURN [some]};
ENDLOOP;
RETURN [all];
};
percentIndex: INT ← -1;
prefixEnd: INT ← 0;
DO
percentIndex ← value.Find[s2: "%", pos1: percentIndex+1];
IF percentIndex=-1 --no %'s-- OR percentIndex=0 --%*-- THEN EXIT;
SELECT
--*%*-- NumbersTilBeginning[percentIndex]
FROM
all => {token.type ← pattern; RETURN [TRUE]};
some => {token.lookupVal ← value.Substr[start: prefixEnd]; token.prefix ← value.Substr[0, prefixEnd]; token.type ← pattern; RETURN [TRUE]};
ENDCASE --none-- => LOOP; --Prefix may contain %'s: find if there is another %
ENDLOOP;
RETURN [FALSE]; --not a pattern
};
IsNumberedColor:
PROC []
RETURNS [
BOOL] ~ {
--is it a numbered color? Look for "C[0..9]"
NoZeros:
PROC []
RETURNS [noZeros:
ROPE ←
NIL] ~ {
-- C001* => C1*
numberFound: BOOL ← FALSE; --number other than 0 found
noZeroStream: IO.STREAM ~ IO.ROS[];
FOR i:
INT
IN [0..valueLength)
DO
c: CHAR ← value.Fetch[i];
SELECT c
FROM
'0 => IF numberFound THEN --don't eliminate if in middle of number-- IO.PutChar[self: noZeroStream, char: c];
IN ['1..'9] => {numberFound ← TRUE; IO.PutChar[self: noZeroStream, char: c]};
ENDCASE => {numberFound ← FALSE; IO.PutChar[self: noZeroStream, char: c]};
ENDLOOP;
RETURN [IO.RopeFromROS[noZeroStream]];
};
NumbersTilEnd:
PROC [index:
INT]
RETURNS [
BOOL] ~ {
FOR i:
INT
IN [index+1..valueLength)
DO
--looking for eg "C101"
IF ~(value.Fetch[i] IN ['0..'9]) THEN RETURN [FALSE]; --no "." allowed
ENDLOOP;
RETURN [TRUE];
};
cIndex: INT ← -1;
DO
cIndex ← value.Find[s2: "C", pos1: cIndex+1, case: FALSE];
SELECT
TRUE
FROM
cIndex=-1 --no C's-- OR cIndex=valueLength-1 --C at end-- => RETURN [FALSE];
cIndex=0
--C*-- =>
IF NumbersTilEnd[cIndex]
THEN
{token.lookupVal ← NoZeros[]; token.type ← numberedColor; RETURN [TRUE]}
ELSE LOOP; --check for more C's
ENDCASE
--cIndex>0 (PrefixC*)-- =>
IF NumbersTilEnd[cIndex]
THEN
{token.lookupVal ← NoZeros[].Substr[cIndex]; token.prefix ← value.Substr[0, cIndex]; token.type ← numberedColor; RETURN [TRUE]}
ELSE LOOP; --check for more C's
ENDLOOP;
};
IsKeyword:
PROC []
RETURNS [
BOOL] ~ {
--is it a keyword? Check colorizingKeys
SweepKeyOK:
PROC [r:
ROPE, i:
INT]
RETURNS [ok:
BOOL ←
TRUE] ~ {
IF r.Equal["Sweep"]
AND valueLength>i
THEN
SELECT value.Fetch[i]
FROM IN ['0..'9], '., '- =>
NULL;
--Sweep<angle> allowed
ENDCASE => ok ← FALSE; --eg, "Sweeps" not a keyword
};
FOR each:
LIST
OF
ROPE ← colorizingKeys, each.rest
UNTIL each=
NIL
DO
keyLength: INT ~ each.first.Length;
SELECT
TRUE
FROM
valueLength<keyLength => LOOP;
valueLength=keyLength =>
IF value.Equal[s2: each.first, case:
FALSE]
THEN
{token.type ← keyword; RETURN [TRUE]};
ENDCASE
--valueLength>keyLength-- => {
prefixEnd: INT ← Rope.Find[s1: value, s2: each.first, case: FALSE];
SELECT
TRUE
FROM
prefixEnd=0 --long keyword, like Underline.DropShadowOffset or Sweep45, but no prefix-- => IF SweepKeyOK[each.first, 5] THEN {token.type ← keyword; RETURN [TRUE]};
prefixEnd>0 --eg, DefaultUnderline.DropShadowOffset-- => IF SweepKeyOK[each.first, prefixEnd+5] THEN {token.lookupVal ← value.Substr[start: prefixEnd]; token.type ← keyword; token.prefix ← value.Substr[0, prefixEnd]; RETURN [TRUE]};
ENDCASE => NULL; --will be -1 if value not contained in keywd
};
ENDLOOP;
RETURN [FALSE]; --not a colorizingKey
};
IsValidNamedColor:
PROC [palette: Profiles.Profile]
RETURNS [
BOOL] ~ {--
checks registered named colors to see if colorName is among them (case
FALSE)
i: INT ← 0;
c: CHAR;
UNTIL (c ← value.Fetch)
NOT
IN [
IO.
NUL ..
IO.
SP]
OR c#'\t
DO
--find first non-space
i ← i+1;
ENDLOOP;
IF Profiles.HasEntry[profile: palette, key: Rope.Concat["IPFragFor", value.Substr[start: i]]] THEN {token.type ← namedColor; RETURN [TRUE]};
RETURN [FALSE]; --not a registered named color
};
valueLength: INT ~ value.Length;
token ← NEW [TokenRep ← [lookupVal: value, spaceBefore: IF charsSkipped=0 THEN "" ELSE " ", type: other]]; --other fields default
SELECT
TRUE
FROM
IsIPFrag[] => RETURN;
IsSeparator[] => RETURN;
IsNumber[] => RETURN;
IsPattern[] => RETURN;
IsNumberedColor[] => RETURN;
IsKeyword[] => RETURN;
IsValidNamedColor[palette] => RETURN;
ENDCASE --other-- => RETURN;
};