<<>>
<<ColorizeViewPointImplB.mesa>>
    <<Copyright Ó 1988, 1989, 1990 by Xerox Corporation.  All rights reserved.>>
    <<Bob Coleman, August 31, 1990 2:42:20 pm PDT>>
    <<>>
    DIRECTORY
        ColorizeViewPoint, ColorizeViewPointBackdoor, ProfilesBackdoor, ProfilesPrivate, ImagerFont, IO, Profiles, Rope, SymTab;

    ColorizeViewPointImplB: CEDAR PROGRAM
    IMPORTS ColorizeViewPoint, ColorizeViewPointBackdoor, ImagerFont, IO, Profiles, ProfilesBackdoor, Rope, SymTab
    EXPORTS ColorizeViewPointBackdoor
    ~ BEGIN
    OPEN ColorizeViewPoint, ColorizeViewPointBackdoor;
<<Registration Mechanisms>>
    colorizingKeys: LIST OF ROPE _ NIL;
    RegisterKeywords: PUBLIC PROC [keywordsList: LIST OF ROPE] ~ {--tracks the colorizing keywords used by all the Colorizations, 
    registered by them with this proc
        FOR each: LIST OF ROPE _ keywordsList, each.rest UNTIL each=NIL DO 
            colorizingKeys _ CONS[each.first, colorizingKeys];
            ENDLOOP;
        };
<<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;
        };


    END.