<<>>
    <<ProfilesImpl.mesa>>
        <<Copyright Ó 1984, 1985, 1986, 1987, 1988, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Bob Hagmann May 22, 1985 4:50:10 pm PDT>>
        <<Russ Atkinson (RRA) November 28, 1988 10:48:34 pm PST>>
        <<Hal Murray, January 14, 1986 4:22:44 am PST>>
        <<Doug Wyatt, June 10, 1987 5:09:27 pm PDT>>
        <<Eric Nickell, May 17, 1988 4:47:12 pm PDT>>
        <<Bob Coleman, August 29, 1989 12:44:50 pm PDT>>
        <<Dave Rumph, January 8, 1990 12:02:55 pm PST>>
        <<Michael Plass, November 25, 1991 11:28 am PST>>

        DIRECTORY
            PFS USING [Error, PathFromRope, StreamOpen],
            Profiles,
            ProfilesBackdoor,
            ProfilesPrivate USING [ProfileChangedItem, ProfileRep],
            Convert USING [IntFromRope],
            IO,
            Rope USING [ROPE, Cat, Concat, Equal, Index, Match, Substr],
            RuntimeError USING [UNCAUGHT],
            SymTab USING [Create, EachPairAction, Fetch, Pairs, Ref, Store];
            <<UXIO USING [CreateFileStream, Error];>>


    ProfilesImpl: CEDAR MONITOR
        IMPORTS Convert, IO, PFS, Rope, RuntimeError, SymTab--, UXIO--
        EXPORTS Profiles, ProfilesBackdoor 
        = BEGIN
        OPEN Profiles, ProfilesBackdoor;
        <<>>
    <<>>
    <<Global Data>>
        profileDir: ROPE Ź NIL;
        freshProfiles: LIST OF Profile Ź NIL;

    <<Creating the Profile>>
        Profile: PUBLIC TYPE ~ REF ProfileRep;
        ProfileRep: PUBLIC TYPE ~ ProfilesPrivate.ProfileRep;
        ProfileChangedItem: TYPE ~ ProfilesPrivate.ProfileChangedItem;

        Create: PUBLIC PROC [files: LIST OF ROPE, keepFresh: BOOL Ź TRUE] RETURNS [profile: Profile] ~ {
            <<Parses a set of profile files and returns the data structure which can be used to access the values.>>
            SlicesFromFileNames: PROC [files: LIST OF ROPE] RETURNS [slices: LIST OF Slice] ~ {
                dummy: LIST OF Slice ~ LIST[[rope[NIL]]];
                tail: LIST OF Slice Ź dummy;
                FOR each: LIST OF ROPE Ź files, each.rest UNTIL each=NIL DO
                    tail Ź (tail.rest Ź LIST[[file[fileName: each.first]]]);
                    ENDLOOP;
                RETURN [dummy.rest];
                };
            profile Ź NEW[ProfileRep Ź [
                entries: NIL,        --Set by ParseProfile
                filesUsed: SymTab.Create[case: FALSE],
                slices: SlicesFromFileNames[files],
                keepFresh: keepFresh
                ]];
            ParseProfile[profile];
            IF keepFresh THEN freshProfiles Ź CONS[profile, freshProfiles];
            };
            <<>>
        CreateFromRope: PUBLIC PROC [slices: LIST OF ROPE] RETURNS [profile: Profile] ~ {
            <<Parses a set of profile files and returns the data structure which can be used to access the values.>>
            SlicesFromRopes: PROC [slices: LIST OF ROPE] RETURNS [LIST OF Slice] ~ {
                dummy: LIST OF Slice ~ LIST[[rope[NIL]]];
                tail: LIST OF Slice Ź dummy;
                FOR each: LIST OF ROPE Ź slices, each.rest UNTIL each=NIL DO
                    tail Ź (tail.rest Ź LIST[[rope[each.first]]]);
                    ENDLOOP;
                RETURN [dummy.rest];
                };
            profile Ź NEW[ProfileRep Ź [
                entries: NIL,        --Set by ParseProfile
                filesUsed: SymTab.Create[case: FALSE],
                slices: SlicesFromRopes[slices],
                keepFresh: FALSE
                ]];
            ParseProfile[profile];
            <<IF keepFresh THEN freshProfiles _ CONS[profile, freshProfiles];    --Always FALSE>>
            };
            <<>>
        CreateFromSlices: PUBLIC PROC [slices: LIST OF Slice, keepFresh: BOOL Ź TRUE] RETURNS [profile: Profile] ~ {
            <<Parses a set of profile files and returns the data structure which can be used to access the values.>>
            profile Ź NEW[ProfileRep Ź [
                entries: NIL,        --Set by ParseProfile
                filesUsed: SymTab.Create[case: FALSE],
                slices: slices,
                keepFresh: keepFresh
                ]];
            ParseProfile[profile];
            IF keepFresh THEN freshProfiles Ź CONS[profile, freshProfiles];
            };
            <<>>
        LetProfileGetStale: PUBLIC ENTRY PROC [profile: Profile] ~ {
            IF profile.keepFresh THEN {
                dummy: LIST OF Profile Ź CONS[NIL, freshProfiles];
                FOR each: LIST OF Profile Ź dummy, each.rest DO    --Addr fault => ERROR
                    IF each.rest.first=profile THEN {
                        each.rest Ź each.rest.rest;
                        EXIT;
                        };
                    ENDLOOP;
                profile.keepFresh Ź FALSE;
                };
            };

        <<>>
    <<Accessing profile>>
        <<>>
        Boolean: PUBLIC PROC [profile: Profile, key: ROPE, default: BOOL Ź FALSE] RETURNS [value: BOOL] = {
            entry: ProfileEntry;
            val: ROPE;
            entry Ź Lookup[profile, key];
            val Ź GetRope[entry];
            IF val = NIL THEN RETURN [default];
            IF val.Equal["TRUE", FALSE] THEN RETURN [TRUE];
            IF val.Equal["FALSE", FALSE] THEN RETURN [FALSE];
            Report[entry, val.Concat[" is not a Boolean"]];
            RETURN [default];
            };

        Number: PUBLIC PROC [profile: Profile, key: ROPE, default: INT] RETURNS [value: INT] = {
            entry: ProfileEntry Ź Lookup[profile, key];
            val: ROPE Ź GetRope[entry];
            IF val = NIL THEN RETURN [default];
            value Ź Convert.IntFromRope[val
                ! RuntimeError.UNCAUGHT => {
                    value Ź default; 
                    Report[entry, val.Concat[" is not an INT"]];
                    CONTINUE;
                    }
                ];
            };

        Token: PUBLIC PROC [profile: Profile, key: ROPE, default: ROPE] RETURNS [value: ROPE] = {
            entry: ProfileEntry Ź Lookup[profile, key];
            val: ROPE Ź GetRope[entry];
            IF val = NIL THEN RETURN [default];
            value Ź  val;
            };

        ListOfTokens: PUBLIC PROC [profile: Profile, key: ROPE, default: LIST OF ROPE] RETURNS [value: LIST OF ROPE] = {
            entry: ProfileEntry Ź Lookup[profile, key];
            IF entry = NIL THEN RETURN [default] ELSE RETURN [entry.tokens];
            };

        Line: PUBLIC PROC [profile: Profile, key: ROPE, default: ROPE] RETURNS [value: ROPE] = {
            entry: ProfileEntry Ź Lookup[profile, key];
            IF entry = NIL THEN RETURN [default];
            FOR l: LIST OF ROPE Ź entry.tokens, l.rest UNTIL l = NIL DO
                IF value = NIL THEN value Ź l.first ELSE
                value Ź value.Cat[" ", l.first];
                ENDLOOP;
            };

        EnumerateKeys: PUBLIC PROC [profile: Profile, pattern: ROPE, proc: EnumProc] ~ {
            Enum: SymTab.EachPairAction = {
                <<[key: ROPE, val: SymTab.Val] RETURNS [quit: BOOL _ FALSE]>>
                IF Rope.Match[pattern: pattern, object: key, case: FALSE] THEN RETURN [proc[key]];
                };
            [] Ź SymTab.Pairs[x: profile.entries, action: Enum];
            };

        HasEntry: PUBLIC ENTRY PROC [profile: Profile, key: ROPE] RETURNS [BOOL] ~ {
            ENABLE UNWIND => NULL;
            RETURN [FetchInternal[profile, key].found];
            };

        Lookup: PUBLIC ENTRY PROC [profile: Profile, key: ROPE] RETURNS [ProfileEntry] = {
            ENABLE UNWIND => NULL;
            RETURN [LookupInternal[profile, key]]
            };

        LookupInternal: INTERNAL PROC [profile: Profile, key: ROPE] RETURNS [ProfileEntry] = {
            RETURN [NARROW[FetchInternal[profile, key].val]];
            };

        FetchInternal: INTERNAL PROC [profile: Profile, key: ROPE] RETURNS [found: BOOL, val: REF ANY] ~ {
            [found: found, val: val] Ź SymTab.Fetch[x: profile.entries, key: key];
            };

        GetRope: PROC [entry: ProfileEntry] RETURNS [value: ROPE] = INLINE {
            IF entry = NIL OR entry.tokens = NIL THEN RETURN [NIL];
            value Ź entry.tokens.first;
            IF entry.tokens.rest # NIL THEN Report[entry, "extra material on line"];
            };

        GetProfileSlices: PUBLIC PROC [profile: Profile] RETURNS [LIST OF Slice] = {
            RETURN [profile.slices];
            };

        GetProfileNames: PUBLIC PROC [profile: Profile] RETURNS [LIST OF ROPE] = {
            dummy: LIST OF ROPE ~ LIST[NIL];
            tail: LIST OF ROPE Ź dummy;
            FOR each: LIST OF Slice Ź profile.slices, each.rest UNTIL each=NIL DO
                WITH each.first SELECT FROM
                    fileSlice: Slice.file => tail Ź (tail.rest Ź LIST[fileSlice.fileName]);
                    ENDCASE;
                ENDLOOP;
            RETURN [dummy.rest];
            };

        <<>>
    <<Building profileList>>


        NoVersion: PROC [file: ROPE] RETURNS [ROPE] ~ {
            RETURN [Rope.Substr[base: file, len: Rope.Index[s1: file, s2: "!"]]];
            };

        ParseProfile: ENTRY PROC [profile: Profile] ~ {
            ENABLE UNWIND => NULL;
            TryProfile: INTERNAL PROC [slice: Slice] ~ {
                stream: IO.STREAM Ź NIL;
                WITH slice SELECT FROM
                    slice: Slice.rope => stream Ź IO.RIS[rope: slice.text];
                    slice: Slice.file => {
                        profileName: ROPE Ź Rope.Concat[profileDir, slice.fileName];
                        <<stream _ UXIO.CreateFileStream[profileName, read ! UXIO.Error => CONTINUE];>>
                        stream Ź PFS.StreamOpen[fileName: PFS.PathFromRope[profileName], accessOptions: read ! PFS.Error => CONTINUE];
                        IF stream = NIL THEN RETURN;
                        [] Ź SymTab.Store[x: profile.filesUsed, key: profileName, val: $Parent];
                        };
                    ENDCASE => ERROR;
                ParseProfileInternal[profile, stream];
                };
            profile.entries Ź SymTab.Create[case: FALSE];
            profile.filesUsed Ź SymTab.Create[case: FALSE];
            FOR each: LIST OF Slice Ź profile.slices, each.rest UNTIL each=NIL DO
                TryProfile[each.first];
                ENDLOOP;
            };

        ParseProfileInternal: INTERNAL PROC [profile: Profile, stream: IO.STREAM] ~ {
            <<Given an open stream, parse the profile and close the stream.  Successive calls "overwrite" previous entries.>>
            DO
                ENABLE {
                    RuntimeError.UNCAUGHT => EXIT;
                    UNWIND => IO.Close[stream];
                    };
                SkipWhite: PROC [flushLines: BOOL Ź FALSE] RETURNS [c: CHAR] = {
                    DO
                        ENABLE IO.Error, IO.EndOfStream => GO TO stop;
                        c Ź stream.PeekChar[];
                        SELECT c FROM
                            '\n, '\r, '\l => IF NOT flushLines THEN RETURN;
                            <= 40C => {};
                            '- => {-- could be a comment
                                [] Ź stream.GetChar[];
                                IF stream.PeekChar[] # '- THEN {
                                    <<it is not a comment>>
                                    stream.Backup[c];
                                    RETURN [c];
                                    };
                                DO
                                    <<the end of a comment is either a '\n or a double ->>
                                    c Ź stream.GetChar[];
                                    SELECT c FROM
                                        '\n, '\r, '\l => {
                                            <<Only flush the \n if it was requested>>
                                            stream.Backup[c];
                                            IF flushLines THEN EXIT;
                                            RETURN;
                                            };
                                        '- => IF stream.PeekChar[] = '- THEN EXIT;
                                        ENDCASE;
                                    ENDLOOP;
                                };
                            ENDCASE => RETURN;
                        [] Ź stream.GetChar[];
                        ENDLOOP;
                    EXITS stop => {c Ź 0C};
                    };
                LocalToken: PROC [flushLines: BOOL Ź FALSE] = {
                    stop: CHAR Ź SkipWhite[flushLines];
                    position Ź stream.GetIndex[];
                    token Ź NIL;
                    SELECT stop FROM
                        0C, '\n, '\r, '\l => RETURN;
                        '" => token Ź stream.GetRopeLiteral[];
                        ENDCASE => token Ź stream.GetTokenRope[tokenProc].token;
                    };
                tokenProc: IO.BreakProc = {
                    RETURN [SELECT char FROM
                        IO.SP, IO.TAB--, ',-- => sepr,
                        IO.LF, IO.CR, ': => break,
                        ENDCASE => other
                        ];
                    };
                Cat: PROC [a, b: LIST OF ROPE] RETURNS [LIST OF ROPE] ~ {
                    RETURN [IF a=NIL THEN b ELSE CONS[a.first, Cat[a.rest, b]]];
                    };
                LookupTokens: INTERNAL PROC [key: ROPE] RETURNS [tokens: LIST OF ROPE] ~ {
                    entry: ProfileEntry ~ LookupInternal[profile, key];
                    RETURN [IF entry=NIL THEN NIL ELSE entry.tokens];
                    };
                token: ROPE Ź NIL;
                tokens, tail: LIST OF ROPE Ź NIL;
                position: INT Ź 0;
                key: ROPE Ź NIL;
                additive: {none, prefix, suffix};
                LocalToken[TRUE];
                IF (key Ź token) = NIL THEN EXIT;
                SELECT SkipWhite[] FROM
                    ': => {
                        [] Ź stream.GetChar[];  -- flush the ':
                        IF (additive Ź SELECT stream.PeekChar[] FROM
                            '< => prefix,
                            '> => suffix,
                            ENDCASE => none)#none THEN [] Ź stream.GetChar[];  --flush '< or '> if needed
                        };
                    ENDCASE => {
                        <<key was NOT followed by ':, so flush to the end of line and report the error>>
                        DO
                            SELECT stream.GetChar[ ! IO.EndOfStream => EXIT] FROM
                                '\n, '\r, '\l => EXIT;
                                ENDCASE;
                            ENDLOOP;
                        ReportInternal[msg: IO.PutFR1["missing : at [%d]", IO.int[position]]];
                        LOOP;
                        };
                DO
                    list: LIST OF ROPE Ź NIL;
                    LocalToken[];
                    IF token = NIL THEN EXIT;
                    list Ź LIST[token];
                    IF tail = NIL
                        THEN {tail Ź tokens Ź list}
                        ELSE {tail.rest Ź list; tail Ź list};
                    ENDLOOP;
                IF key.Equal["Include", FALSE] THEN {    --Insert a profile slice
                    FOR each: LIST OF ROPE Ź tokens, each.rest UNTIL each=NIL DO
                        profileSlice: IO.STREAM Ź NIL;
                        profileName: ROPE Ź Rope.Concat[profileDir, each.first];
                        <<profileSlice _ UXIO.CreateFileStream[profileName, read ! UXIO.Error => CONTINUE];>>
                        profileSlice Ź PFS.StreamOpen[PFS.PathFromRope[profileName], read ! PFS.Error => CONTINUE];
                        IF profileSlice # NIL
                            THEN {
                                [] Ź SymTab.Store[x: profile.filesUsed, key: profileName, val: $Child];
                                ParseProfileInternal[profile, profileSlice];
                                }
                            ELSE ReportInternal[
                                entry: NEW[ProfileRecord Ź [each.first, tokens, position]],
                                msg: "File not found."
                                ];
                        ENDLOOP;
                    }
                ELSE {                --Add a profile entry
                    SELECT additive FROM
                        prefix => tokens Ź Cat[tokens, LookupTokens[key]];
                        suffix => tokens Ź Cat[LookupTokens[key], tokens];
                        ENDCASE => IF LookupInternal[profile, key] # NIL THEN
                            ReportInternal[
                                entry: LookupInternal[profile, key],
                                msg: IO.PutFR["%g also appears at [%d]", [rope[key]], [integer[position]]]
                                ];
                    [] Ź SymTab.Store[x: profile.entries, key: key, val: NEW[ProfileRecord Ź [key, tokens, position]]]
                    };
                ENDLOOP;
            IO.Close[stream];
            };
    <<>>
    <<Reporting errors>>

        Error: PUBLIC ERROR [reason: ROPE] ~ CODE;
        Report: PUBLIC ENTRY PROC [entry: ProfileEntry Ź NIL, msg: ROPE] = {
            ENABLE UNWIND => NULL;
            ReportInternal[entry, msg];
            };

        ReportInternal: INTERNAL PROC [entry: ProfileEntry Ź NIL, msg: ROPE] = {
            ENABLE RuntimeError.UNCAUGHT => CONTINUE;
            msg Ź IO.PutFR1["\n\n%g", [rope[msg]]];
            IF entry#NIL THEN msg Ź IO.PutFLR["%g, at %g [%d]", LIST[[rope[msg]], [rope[entry.key]], [integer[entry.position]]]];
            Error[msg];
            };
    <<>>
    <<When the profile changes>>
        <<Note that registration order is important; procs must be called in the same order in which they were registered (otherwise 
        deadlocks may occur at rollback time).>>

        ProfileChangeList: TYPE ~ LIST OF ProfileChangedItem;

        AddToList: ENTRY PROC [profile: Profile, item: ProfileChangedItem] ~ {
            dummy: ProfileChangeList Ź CONS[[NIL, NIL], profile.changeWatchers];
            FOR each: ProfileChangeList Ź dummy, each.rest DO
                IF each.rest=NIL THEN {each.restŹLIST[item]; EXIT};    --Append to end
                ENDLOOP;
            profile.changeWatchers Ź dummy.rest;
            };

        CopyList: ENTRY PROC [toCopy: LIST OF ProfileChangedItem] RETURNS [LIST OF ProfileChangedItem] ~ {
            RETURN [IF toCopy=NIL THEN NIL ELSE CONS[toCopy.first, CopyList[toCopy.rest]]];
            };

        CallWhenProfileChanges: PUBLIC PROC [profile: Profile, proc: Profiles.ProfileChangedProc, clientData: REF] = {
            item: ProfileChangedItem ~ [proc, clientData];
            IF profile.keepFresh THEN AddToList[profile, item];
            DoIt[profile, item, firstTime];
            };

        ProfileChanged: PUBLIC ProfileChangedProc = {
            ParseProfile[profile: profile ! RuntimeError.UNCAUGHT => CONTINUE];
            FOR each: ProfileChangeList Ź CopyList[profile.changeWatchers], each.rest UNTIL each=NIL DO
                DoIt[profile, each.first, reason];
                ENDLOOP;
            };

        DoIt: PROC [profile: Profile, item: ProfileChangedItem, reason: Profiles.ProfileChangeReason] = {
            item.proc[
                profile: profile,
                reason: reason,
                clientData: item.clientData
                ! RuntimeError.UNCAUGHT => {
                    Report[msg: "Problem while executing ProfileChangedProc"];
                    CONTINUE
                    }
                ];
            };


    END.
    <<>>