
    <<WalnutQueryImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Spreitzer, July 25, 1985 8:58:17 pm PDT>>
        <<Rick Beach, July 12, 1986 6:00:09 pm PDT>>

    DIRECTORY BasicTime, Convert, IO, Process, RefText, Rope, TextFind, ViewerTools, ViewRec, WalnutDefs, WalnutOps, WalnutParseMsg, 
    WalnutQuery, WalnutWindow;

    WalnutQueryImpl: CEDAR PROGRAM
    IMPORTS BasicTime, Convert, Process, RefText, Rope, TextFind, ViewRec, WalnutOps, WalnutWindow
    EXPORTS WalnutQuery =
    BEGIN OPEN WalnutQuery;

        Time: TYPE = BasicTime.GMT;

        MessageConsumer: TYPE = PROC [Message];

        TestList: TYPE = LIST OF Test;

        TextMatch: TYPE = REF TextMatchRep;
        TextMatchRep: TYPE = RECORD [
            where: ROPE --NIL means body--,
            finder: TextFind.Finder];

        TestTextMatch: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            tm: TextMatch _ NARROW[data];
            subject: ROPE _ GetPart[msg, tm.where];
            found: BOOL _ TextFind.SearchRope[tm.finder, subject].found;
            RETURN [found];
            };

        DateRange: TYPE = REF DateRangeRep;
        DateRangeRep: TYPE = RECORD [
            start, end: Time];

        TestDateRange: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            dr: DateRange _ NARROW[data];
            dateRope: ROPE _ GetPart[msg, "Date"];
            date: Time _ BasicTime.nullGMT;
            inRange: BOOL;
            date _ Convert.TimeFromRope[dateRope !Convert.Error => CONTINUE];
            inRange _ date # BasicTime.nullGMT AND BasicTime.Period[dr.start, date]>=0 AND BasicTime.Period[date, dr.end]>=0;
            RETURN [inRange];
            };

        InMsgSet: TYPE = REF InMsgSetRep;
        InMsgSetRep: TYPE = RECORD [
            name: ROPE];

        TestInMsgSet: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            ims: InMsgSet _ NARROW[data];
            FOR msl: LOR _ msg.msList, msl.rest WHILE msl # NIL DO
                IF ims.name.Equal[msl.first, FALSE] THEN RETURN [TRUE];
                ENDLOOP;
            RETURN [FALSE];
            };

        Not: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            t: Test _ NARROW[data];
            RETURN [NOT t.Eval[msg, t.data]]};

        And: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            tl: TestList _ NARROW[data];
            FOR tl _ tl, tl.rest WHILE tl # NIL DO
                IF NOT tl.first.Eval[msg, tl.first.data] THEN RETURN [FALSE];
                ENDLOOP;
            RETURN [TRUE]};

        Or: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            tl: TestList _ NARROW[data];
            FOR tl _ tl, tl.rest WHILE tl # NIL DO
                IF tl.first.Eval[msg, tl.first.data] THEN RETURN [TRUE];
                ENDLOOP;
            RETURN [FALSE]};

        XOr: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            tl: TestList _ NARROW[data];
            ans: BOOL _ FALSE;
            FOR tl _ tl, tl.rest WHILE tl # NIL DO
                ans _ ans # tl.first.Eval[msg, tl.first.data];
                ENDLOOP;
            RETURN [ans]};

        Iff: PROC [msg: Message, data: REF ANY] RETURNS [BOOL] = {
            tl: TestList _ NARROW[data];
            ans: BOOL _ FALSE;
            FOR tl _ tl, tl.rest WHILE tl # NIL DO
                ans _ ans = tl.first.Eval[msg, tl.first.data];
                ENDLOOP;
            RETURN [ans]};

        Prepare: PROC [ra: REF ANY] RETURNS [test: Test] = {
            WITH ra SELECT FROM
                rope: ROPE => test _ Prepare[LIST[$textMatch, bodyKey, rope]];
                refText: REFTEXT => test _ Prepare[LIST[$textMatch, bodyKey, refText]];
                lora: LORA => {
                    key: ATOM _ NARROW[lora.first];
                    SELECT key FROM
                        $textMatch => {
                            tm: TextMatch _ NEW [TextMatchRep _ [NarrowToRope[lora.rest.first], NIL]];
                            literal: BOOL _ TRUE;
                            word: BOOL _ FALSE;
                            ignoreCase: BOOL _ TRUE;
                            addBounds: BOOL _ FALSE;
                            FOR l: LORA _ lora.rest.rest, l.rest WHILE l # NIL DO
                                r: REF ANY _ l.first;
                                WITH r SELECT FROM
                                    rope: ROPE => {
                                        IF tm.finder # NIL THEN ERROR;
                                        tm.finder _ TextFind.CreateFromRope[pattern: rope, literal: literal, word: word, ignoreCase: ignoreCase, addBounds: addBounds];
                                        };
                                    refText: REFTEXT => {
                                        IF tm.finder # NIL THEN ERROR;
                                        tm.finder _ TextFind.CreateFromRope[pattern: Rope.FromRefText[refText], literal: literal, word: word, ignoreCase: ignoreCase, 
                                        addBounds: addBounds];
                                        };
                                    atom: ATOM => SELECT atom FROM
                                        $literal => literal _ TRUE;
                                        $pattern => literal _ FALSE;
                                        $word => word _ TRUE;
                                        $anywhere => addBounds _ word _ FALSE;
                                        $ignoreCase => ignoreCase _ TRUE;
                                        $testCase => ignoreCase _ FALSE;
                                        $addBounds => addBounds _ TRUE;
                                        ENDCASE => ERROR;
                                    ENDCASE => ERROR;
                                ENDLOOP;
                            test _ NEW [TestRep _ [TestTextMatch, tm]];
                            };
                        $dateRange => {
                            dr: DateRange _ NEW [DateRangeRep _ [
                                start: ParseTime[lora.rest.first],
                                end: ParseTime[lora.rest.rest.first]
                                ]];
                            test _ NEW [TestRep _ [TestDateRange, dr]];
                            };
                        $inMsgSet => {
                            ims: InMsgSet _ NEW [InMsgSetRep _ [NarrowToRope[lora.rest.first]]];
                            test _ NEW [TestRep _ [TestInMsgSet, ims, ims.name]];
                            };
                        $not => test _ NEW [TestRep _ [Not, Prepare[lora.rest.first]]];
                        $and => {
                            test _ NEW [TestRep _ [And, PrepareList[lora.rest]]];
                            test.msgSet _ PickSmallestMsgSet[NARROW[test.data]];
                            };
                        $or => {
                            test _ NEW [TestRep _ [Or, PrepareList[lora.rest]]];
                            test.msgSet _ FindSameMsgSet[NARROW[test.data]]
                            };
                        $xor => {
                            test _ NEW [TestRep _ [XOr, PrepareList[lora.rest]]];
                            test.msgSet _ FindSameMsgSet[NARROW[test.data]]
                            };
                        $iff => {
                            test _ NEW [TestRep _ [Iff, PrepareList[lora.rest]]];
                            test.msgSet _ FindSameMsgSet[NARROW[test.data]]
                            };
                        ENDCASE => ERROR;
                    };
                ENDCASE => ERROR;
            };

        PickSmallestMsgSet: PROC [tl: TestList] RETURNS [msgSet: ROPE _ NIL] ~ {
            maxSize: INT _ LAST[INT];
            FOR tl _ tl, tl _ tl.rest WHILE tl # NIL AND tl.first # NIL DO
                IF NOT Rope.IsEmpty[tl.first.msgSet] THEN {
                    size: INT _ WalnutOps.SizeOfMsgSet[tl.first.msgSet].messages;
                    IF size < maxSize THEN { maxSize _ size; msgSet _ tl.first.msgSet };
                    };
                ENDLOOP;
            };

        FindSameMsgSet: PROC [tl: TestList] RETURNS [msgSet: ROPE _ NIL] ~ {
            FOR tl _ tl, tl _ tl.rest WHILE tl # NIL AND tl.first # NIL DO
                IF Rope.IsEmpty[tl.first.msgSet] THEN RETURN [NIL]
                ELSE {
                    IF Rope.IsEmpty[msgSet] THEN msgSet _ tl.first.msgSet  -- first message set
                    ELSE IF NOT Rope.Equal[msgSet, tl.first.msgSet, FALSE] THEN RETURN [NIL];
                    };
                ENDLOOP;
            };

        bodyKey: ROPE = NIL;

        ParseTime: PROC [asAny: REF ANY] RETURNS [time: Time] =
            {time _ Convert.TimeFromRope[NarrowToRope[asAny]]};

        NarrowToRope: PROC [asAny: REF ANY] RETURNS [rope: ROPE] = {
            rope _ IF asAny # NIL
                THEN WITH asAny SELECT FROM
                    rope: ROPE => rope,
                    refText: REFTEXT => Rope.FromRefText[refText],
                    ENDCASE => ERROR
                ELSE NIL;
            };

        PrepareList: PROC [lora: LORA] RETURNS [tl: TestList] = {
            tail: TestList _ tl _ NIL;
            FOR lora _ lora, lora.rest WHILE lora # NIL DO
                this: TestList _ LIST[Prepare[lora.first]];
                IF tail # NIL THEN tail.rest _ this ELSE tl _ this;
                tail _ this;
                ENDLOOP;
            tl _ tl;
            };

        Apply: PROC [test: Test, consume: MessageConsumer, status: Status] = {
            enumerator: WalnutOps.EnumeratorForMsgs;
            msg: Message _ NEW [MessageRep _ [NIL, NIL, NIL]];
            IF Rope.IsEmpty[test.msgSet] THEN enumerator _ WalnutOps.EnumerateMsgs[]
            ELSE enumerator _ WalnutOps.EnumerateMsgsInMsgSet[test.msgSet];
            DO
                msgID: ROPE;
                msList: LOR;
                headersAsText: REFTEXT;
                [msgID, msList, headersAsText] _ WalnutOps.NextMsg[enumerator];
                IF msgID = NIL THEN EXIT;
                msg^ _ [msgID, msList, WalnutOps.ParseHeaders[RefText.TrustTextAsRope[headersAsText], NIL]];
                status.enumerated _ status.enumerated + 1;
                IF test.Eval[msg, test.data] THEN {
                    status.accepted _ status.accepted + 1;
                    consume[msg];
                    };
                Process.CheckForAbort[];
                ENDLOOP;
            msg _ msg;
            };

        GetPart: PROC [msg: Message, part: ROPE] RETURNS [value: ROPE] = {
            IF part = bodyKey THEN {
                value _ WalnutOps.GetMsg[msg.msgID].contents.contents;
                RETURN;
                };
            FOR hl: Headers _ msg.headers, hl.rest WHILE hl # NIL DO
                IF hl.first.fieldName.Equal[part, FALSE] THEN RETURN [hl.first.value];
                ENDLOOP;
            value _ NIL;
            };

        ToDo: TYPE = LIST OF Add;
        Add: TYPE = RECORD [msgID, msgSetFrom: ROPE];

        FilterToMsgSet: PUBLIC PROC [filter: REF ANY, msgSetName: ROPE, status: Status _ NIL]
        RETURNS [outCome: WalnutWindow.OutCome] = {
            test: Test;
            dest: WalnutDefs.MsgSet = [msgSetName];
            toDo: ToDo _ NIL;
            PerMsg: PROC [msg: Message] = {
                toDo _ CONS[[msg.msgID, msg.msList.first], toDo];
                };
            DoIt: PROC [] RETURNS [doReset: BOOL] = {
                WalnutOps.CreateMsgSet[msgSetName, WalnutOps.dontCareDomainVersion];
                FOR tdl: ToDo _ toDo, tdl.rest WHILE tdl # NIL DO
                    a: Add _ tdl.first;
                    [] _ WalnutOps.AddMsg[msg: a.msgID, from: [a.msgSetFrom], to: dest];
                    status.added _ status.added + 1;
                    ENDLOOP;
                doReset _ TRUE};
            IF status = NIL THEN status _ NEW [StatusRec _ []];
            status^ _ [phase: preparing];
            test _ Prepare[filter];
            status^ _ [
                phase: enumerating,
                msgSet: test.msgSet,
                total: IF Rope.IsEmpty[test.msgSet]
                THEN WalnutOps.SizeOfDatabase[].messages
                ELSE WalnutOps.SizeOfMsgSet[test.msgSet].messages
                ];
            Apply[test, PerMsg, status];
            status.phase _ adding;
            outCome _ WalnutWindow.QueueCall[DoIt];
            status.phase _ idle;
            };

        NewViewedStatus: PUBLIC PROC [name: ROPE _ NIL]
        RETURNS [status: Status --with a RecordViewer on it--] = {
            status _ NEW [StatusRec];
            IF name = NIL THEN name _ "WalnutQuery status";
            [] _ ViewRec.ViewRef[
                agg: status,
                createOptions: [feedBackHeight: 0],
                viewerInit: [name: name]
                ];
            };

    END.