
    <<FileOps.Mesa>>
        <<Copyright © 1984 by Xerox Corporation.  All rights reserved.>>
        <<Last Edited by: Spreitzer, February 11, 1986 1:10:08 pm PST>>

    DIRECTORY Basics, BasicTime, DFUtilities, FileSets, IO, Misp, MoreFileSets, Rope, Tempus;

    FileOps: CEDAR PROGRAM
        IMPORTS FileSets, IO, Misp, MoreFileSets, Rope, Tempus

        ={OPEN FileSets, MoreFileSets;

        RefTime: TYPE = Misp.RefTime;

        idsKey: ATOM _ $FileSetsIdentificationScheme;

        GetIDS: PROC [env: Misp.Environment, stack: Misp.Stack] RETURNS [ids: IdentificationScheme] = {
            r: REF ANY _ NIL;
            r _ Misp.Eval[idsKey, env, stack !Misp.Error => CONTINUE];
            IF r # NIL THEN ids _ WITH r SELECT FROM
                rids: REF IdentificationScheme => rids^,
                ENDCASE => ERROR
            ELSE ERROR;
            };

        EvalFSEnum: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            pattern: ROPE _ NARROW[args.first];
            cooked _ FromFS[pattern, ids];
            };

        EvalDFEnum: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            dfs: FileSet _ NIL;
            filter: DFUtilities.Filter _ [filterC: defining];
            dfw: DFWhich _ remote;
            FOR dl: LORA _ args, dl.rest WHILE dl # NIL DO
                WITH dl.first SELECT FROM
                    a: ATOM => SELECT a FROM
                        $source => filter.filterA _ source;
                        $derived => filter.filterA _ derived;
                        $sourceAndDerived => filter.filterA _ all;
                        $public => filter.filterB _ public;
                        $private => filter.filterB _ private;
                        $publicAndPrivate => filter.filterB _ all;
                        $defining => filter.filterC _ defining;
                        $imported => filter.filterC _ imported;
                        $definingAndImported => filter.filterC _ all;
                        $remote => dfw _ remote;
                        $local => dfw _ local;
                        ENDCASE => SIGNAL Warning[IO.PutFR["Non-understood DF atom %g", IO.atom[a]]];
                    ul: REF DFUtilities.UsingList => {
                        IF filter.list # NIL THEN SIGNAL Warning[IO.PutFR["DF list %g contains more than one using list", IO.refAny[args]]];
                        filter.list _ ul;
                        };
                    r: ROPE => {
                        pattern: ROPE _ IF r.Find["!"] < 0 THEN r.Cat["!H"] ELSE r;
                        these: FileSet _ FromFS[pattern, ids];
                        dfs _ IF dfs = NIL THEN these ELSE Union[LIST[dfs, these]];
                        };
                    fs: FileSet => dfs _ IF dfs = NIL THEN fs ELSE Union[LIST[dfs, fs]];
                    ENDCASE => SIGNAL Warning[IO.PutFR["Non-understood DF thing %g", IO.refAny[dl.first]]];
                ENDLOOP;
            IF dfs = NIL THEN SIGNAL Warning["No DF files specified"];
            cooked _ FromDFs[dfs, filter, dfw, ids];
            };

        EvalUsing: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            n, i: NAT _ 0;
            ul: REF DFUtilities.UsingList;
            FOR nl: LORA _ args, nl.rest WHILE nl # NIL DO
                n _ n + 1;
                ENDLOOP;
            ul _ NEW [DFUtilities.UsingList[n]];
            FOR nl: LORA _ args, nl.rest WHILE nl # NIL DO
                ul[i] _ [FALSE, NARROW[nl.first]];
                i _ i + 1;
                ENDLOOP;
            IF (ul.nEntries _ i) # n THEN ERROR;
            cooked _ ul;
            };

        EvalArchiveEnum: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            which: ArchiveWhich _ SELECT data FROM $archive => archive, $online => online, ENDCASE => ERROR;
            dateRope: ROPE _ NARROW[args.first];
            date: GMT _ Tempus.Parse[dateRope].time;
            cooked _ FromArchiveMsg[date, which, ids];
            };

        EvalArchived: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            fs: FileSet _ NIL;
            FOR args _ args, args.rest WHILE args # NIL DO
                fileName: ROPE _ NARROW[args.first];
                this: FileSet _ FromArchivist[pattern: fileName, ids: ids];
                fs _ IF fs = NIL THEN this ELSE Union[LIST[fs, this]];
                ENDLOOP;
            cooked _ fs;
            };

        EvalFSFromFile: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            fs: FileSet _ NIL;
            FOR args _ args, args.rest WHILE args # NIL DO
                fileName: ROPE _ NARROW[args.first];
                this: FileSet _ FromFile[fileName, ids];
                fs _ IF fs = NIL THEN this ELSE Union[LIST[fs, this]];
                ENDLOOP;
            cooked _ fs;
            };

        EvalFSFromROPE: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            fs: FileSet _ NIL;
            FOR args _ args, args.rest WHILE args # NIL DO
                list: ROPE _ NARROW[args.first];
                this: FileSet _ FromRope[list, ids];
                fs _ IF fs = NIL THEN this ELSE Union[LIST[fs, this]];
                ENDLOOP;
            cooked _ fs;
            };

        FSLAppend: PROC [oldHead, oldTail: FileSetList, fs: FileSet] RETURNS [newHead, newTail: FileSetList] = {
            this: FileSetList = LIST[fs];
            newHead _ oldHead;
            IF oldTail # NIL THEN oldTail.rest _ this ELSE newHead _ this;
            newTail _ this;
            };

        Op: TYPE = PROC [fsl: FileSetList, fr: FileRelation _ NIL] RETURNS [fs: FileSet];

        EvalOp: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            opr: REF Op _ NARROW[data];
            head, tail: FileSetList _ NIL;
            FOR rest: LORA _ args, rest.rest WHILE rest # NIL DO
                sub: FileSet _ NARROW[rest.first];
            [head, tail] _ FSLAppend[head, tail, sub];
                ENDLOOP;
            cooked _ opr[head];
            };

        EvalRealify: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            cooked _ Realify[NARROW[args.first]];
            };

        EvalFilter: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            mispFilter: Misp.Closure _ NARROW[args.first];
            subject: FileSet _ NARROW[args.rest.first];
            EvalMispFilter: PROC [fn: FileNote, data: REF ANY] RETURNS [BOOL] =
                {RETURN [Misp.ApplyFn[mispFilter, LIST[fn], environment, stack] # NIL]};
            filter: Filter;
            TRUSTED {filter _ NEW [FilterRep _ [EvalMispFilter, NIL]]};
            cooked _ FilterFileSet[subject, filter];
            };

        EvalEnumFileSet: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ GetIDS[environment, stack];
            fs: FileSet _ NARROW[args.first];
            consumer: Misp.Closure _ NARROW[args.rest.first];
            PerFile: PROC [fn: FileNote] = {
                [] _ Misp.ApplyFn[consumer, LIST[fn], environment, stack];
                };
            EnumSet[fs, PerFile];
            cooked _ fs;
            };

        EvalFNID: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            fn: FileNote _ NARROW[args.first];
            cooked _ LIST[fn.id.name, NewTime[fn.id.created]]};

        EvalFNName: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            fn: FileNote _ NARROW[args.first];
            cooked _ fn.fsName};

        EvalFNCreated: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            fn: FileNote _ NARROW[args.first];
            cooked _ NewTime[GetCreated[fn]]};

        NewTime: PROC [time: BasicTime.GMT] RETURNS [rt: RefTime] =
            {rt _ NEW [Misp.TimeRec _ [time]]};

        EvalFNRead: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            fn: FileNote _ NARROW[args.first];
            cooked _ NewTime[GetAccounting[fn].read]};

        EvalIDS: PROC [args: LORA, environment: Misp.Environment, data: REF ANY _ NIL, stack: Misp.Stack] RETURNS [cooked: REF ANY] 
        --Misp.EvalProc-- = {
            ids: IdentificationScheme _ [];
            FOR args _ args, args.rest WHILE args # NIL DO
                a: ATOM _ NARROW[args.first];
                SELECT a FROM
                    $withServer => ids.server _ TRUE;
                    $withoutServer => ids.server _ FALSE;
                    $withDirectory => ids.directory _ TRUE;
                    $withoutDirectory => ids.directory _ FALSE;
                    $withVersion => ids.version _ TRUE;
                    $withoutVersion => ids.version _ FALSE;
                    $withCreate => ids.create _ TRUE;
                    $withoutCreate => ids.create _ FALSE;
                    $askFS => ids.askFS _ TRUE;
                    ENDCASE => ERROR;
                ENDLOOP;
            cooked _ NEW [IdentificationScheme _ ids];
            };

        DefineMisps: PROC [env: Misp.Environment] = {
            Misp.Defun[env, $filesMatching, EvalFSEnum];
            Misp.Defun[env, $dfContents, EvalDFEnum];
            Misp.Defun[env, $dfContentsq, EvalDFEnum, FALSE];
            Misp.Defun[env, $using, EvalUsing];
            Misp.Defun[env, $archive, EvalArchiveEnum, TRUE, $archive];
            Misp.Defun[env, $online, EvalArchiveEnum, TRUE, $online];
            Misp.Defun[env, $archived, EvalArchived];
            Misp.Defun[env, $fsFromFile, EvalFSFromFile];
            Misp.Defun[env, $fsFromROPE, EvalFSFromROPE];
            Misp.Defun[env, $fsUnion, EvalOp, TRUE, NEW [Op _ Union]];
            Misp.Defun[env, $fsDiff, EvalOp, TRUE, NEW [Op _ Difference]];
            Misp.Defun[env, $fsSDiff, EvalOp, TRUE, NEW [Op _ SymmetricDifference]];
            Misp.Defun[env, $fsIntersection, EvalOp, TRUE, NEW [Op _ Intersection]];
            Misp.Defun[env, $fsRealify, EvalRealify];
            Misp.Defun[env, $fsFilter, EvalFilter];
            Misp.Defun[env, $enumFileSet, EvalEnumFileSet];
            Misp.Defun[env, $fnID, EvalFNID];
            Misp.Defun[env, $fnName, EvalFNName];
            Misp.Defun[env, $fnCreated, EvalFNCreated];
            Misp.Defun[env, $fnRead, EvalFNRead];
            Misp.Defun[env, $consIDS, EvalIDS];
            Misp.Defun[env, $consIDSq, EvalIDS, FALSE];
            };

        Start: PROC = {
            Misp.RegisterPrimitiveDefiner[DefineMisps];
            };

        Start[];

        }.