
    <<SpellingToolDefinitionImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Created by: Nix>>
        <<Mike Spreitzer July 30, 1986 11:29:25 am PDT>>
        <<Russ Atkinson (RRA) October 30, 1985 4:13:27 pm PST>>
        <<Derek C. Oppen September 22, 1986 2:12:54 pm PDT>>

        DIRECTORY
            AmHerDict,
            AmHerDictRpcControl,
            Atom,
            Convert,
            HashTable,
            IO USING [PutF, PutRope, rope, STREAM],
            Menus USING [MenuProc],
            Rope USING [ROPE, Concat, FromChar, FromRefText, Length, Substr],
            RPC USING [CallFailed, ImportFailed],
            SpellingToolDefinition,
            SpellingToolShared USING [CorrectTiogaOpsCallWithLocks, Selection, ProcessSelection, MapWordsInSelection],
            TextLooks,
            TiogaOps USING [NoSelection],
            TiogaOpsDefs USING [Ref],
            UserCredentials USING [Get];
SpellingToolDefinitionImpl: CEDAR MONITOR 
    IMPORTS AmHerDictRpcControl, Atom, Convert, HashTable, IO, Rope, RPC, SpellingToolShared, TextLooks, TiogaOps, UserCredentials
    EXPORTS SpellingToolDefinition = {

    OPEN SpellingToolShared;
    STREAM: TYPE = IO.STREAM;
    ROPE: TYPE = Rope.ROPE;

    AtomList: TYPE = LIST OF ATOM;
    AtomListList: TYPE = LIST OF AtomList;
    DictRunList: TYPE = LIST OF AmHerDict.Run;

    interface: REF AmHerDictRpcControl.InterfaceRecordObject;
    DefinitionCaveat: BOOL;
    totalDefinitionsCnt, totalDefinitionsWorkedCount: INT _ 0;
    permMessage: STREAM _ NIL;
    dictionary: ATOM _ NIL;
    looksTranslator: HashTable.Table = HashTable.Create[];

    InitializeDictionaryServer: PUBLIC ENTRY PROC [outputStream: STREAM] = {
        ENABLE UNWIND => {};
        permMessage _ outputStream;
        IF interface = NIL THEN TRUSTED {
            interface _ AmHerDictRpcControl.ImportNewInterface[interfaceName: [instance: "DictServer"]
                ! RPC.ImportFailed => GOTO importFailed];
            IF dictionary = NIL THEN SetDictionary[];
            EXITS
                importFailed => NULL;
            };
        totalDefinitionsCnt _ 0;
        totalDefinitionsWorkedCount _ 0;
        };

    SetDictionary: INTERNAL PROC = {
        dictionary _ AmHerDictRpcControl.Dictionaries[interface, UserCredentials.Get[].name].first;
        SetupLooksTranslator[];
        dictionary _ dictionary;
        };


    SetupLooksTranslator: INTERNAL PROC [] = {
        looksDefs: AtomListList = AmHerDictRpcControl.Looks[interface, dictionary];
        looksTranslator.Erase[];
        FOR defs: AtomListList _ looksDefs, defs.rest WHILE defs # NIL DO
            def: AtomList = defs.first;
            dictLook: ATOM = def.first;
            cedarLooks: REF TextLooks.Looks = NEW [TextLooks.Looks _ TextLooks.noLooks];
            FOR pairs: AtomList _ def.rest, pairs.rest.rest WHILE pairs # NIL DO
                attribute: ATOM = pairs.first;
                value: ATOM = pairs.rest.first;
                Bitch: PROC = {
                    permMessage.PutF["Can't cedarize %a=%a on look %a from dictionary %a --- will underline instead\n", [atom[attribute]], 
                    [atom[value]], [atom[dictLook]], [atom[dictionary]]];
                    cedarLooks['z] _ TRUE;
                    };
                SELECT attribute FROM
                    $FAMILY => SELECT value FROM
                        $TIMESROMAN => NULL;
                        $HELVETICA => cedarLooks['o] _ TRUE;
                        $HIPPO => cedarLooks['
                        ENDCASE => Bitch[];
                    $SIZE => {
                        size: INT = Convert.IntFromRope[Atom.GetPName[value]];
                        SELECT size FROM
                            <10 => cedarLooks['s] _ TRUE;
                            =10 => NULL;
                            >12 => cedarLooks['x] _ TRUE;
                            ENDCASE => cedarLooks['l] _ TRUE;
                        };
                    $FACE => SELECT value FROM
                        $STANDARD => NULL;
                        $BOLD => cedarLooks['b] _ TRUE;
                        $ITALIC => cedarLooks['i] _ TRUE;
                        $BOLDITALIC => cedarLooks['b] _ cedarLooks['i] _ TRUE;
                        ENDCASE => Bitch[];
                    $SUPERSCRIPT => cedarLooks['u] _ TRUE;
                    $SUBSCRIPT => cedarLooks['d] _ TRUE;
                    ENDCASE => Bitch[];
                ENDLOOP;
            IF cedarLooks['d] OR cedarLooks['u] THEN cedarLooks['s] _ FALSE;
            IF NOT looksTranslator.Store[dictLook, cedarLooks] THEN ERROR;
            ENDLOOP;
        };


    PutWithRuns: PROC [to: IO.STREAM, rope: ROPE, dictRuns: DictRunList] = {
        size: INT = rope.Length[];
        cedarRuns: TextLooks.Runs _ TextLooks.CreateRun[size];
        FOR drs: DictRunList _ dictRuns, drs.rest WHILE drs # NIL DO
            dr: AmHerDict.Run = drs.first;
            cedarLooks: REF TextLooks.Looks _ NARROW[looksTranslator.Fetch[dr.look].value];
            IF dr.length = 0 THEN LOOP;
            IF cedarLooks = NIL THEN {
                to.PutF["Got unexpected look %a (from dictionary %a) --- will use underlining\n", [atom[dr.look]], [atom[dictionary]]];
                cedarLooks _ unexpectedLooks};
            cedarRuns _ cedarRuns.ChangeLooks[size: size, remove: TextLooks.noLooks, add: cedarLooks^, start: dr.start +             dr.length];
            ENDLOOP;
        cedarRuns _ cedarRuns.Flatten[];
        {PutRun: PROC [start, length: INT, looks: TextLooks.Looks] = {
            pos: ROPE = LooksToRope[looks, positive];
            neg: ROPE = LooksToRope[looks, negative];
            to.PutF["%l%g%l", [rope[pos]], [rope[rope.Substr[start, length]]], [rope[neg]]];
            };
        IF cedarRuns = NIL THEN to.PutRope[rope] ELSE EnumerateRuns[cedarRuns, PutRun];
        }};
        
        unexpectedLooks: REF TextLooks.Looks _ NEW [TextLooks.Looks _ TextLooks.RopeToLooks["z"]];


    LooksToRope: PROC [looks: TextLooks.Looks, sense: {positive, negative}] RETURNS [asRope: ROPE] = {
        asRope _ NIL;
        FOR l: TextLooks.Look IN TextLooks.Look DO
            IF looks[l] THEN asRope _ asRope.Concat[Rope.FromChar[SELECT sense FROM positive => l, negative => l - 'a + 'A, ENDCASE => ERROR]];
            ENDLOOP;
        asRope _ asRope;
        };


    EnumerateRuns: PROC [runs: TextLooks.Runs, Consume: PROC [start, length: INT, looks: TextLooks.Looks], start, offset: INT _ 0, 
    length: INT _ INT.LAST] = {
        WITH runs SELECT FROM
            x: TextLooks.BaseRuns => {
                FOR i: NAT IN [0 .. x.length) WHILE start < length DO
                    Consume[start+offset, MIN[length, x[i].after]-start, x[i].looks];
                    start _ x[i].after;
                    ENDLOOP;
                };
            x: REF TextLooks.Tconcat => {
                EnumerateRuns[x.base, Consume, start, offset, MIN[x.pos, length]];
                IF x.pos < length THEN EnumerateRuns[x.rest, Consume, start-x.pos, x.pos, length-x.pos];
                };
            ENDCASE => ERROR--because we only need work on result of TextLooks.Flatten--;
        };


    FinalizeDictionaryServer: PUBLIC ENTRY PROC [] = {
        IF interface # NIL THEN TRUSTED {
            interface _ NIL;
            };
        permMessage _ NIL;
        };


    DefinitionStats: PUBLIC PROC [] RETURNS [totalDefinitions, totalDefinitionsWorked: INT] = {
        totalDefinitions _ totalDefinitionsCnt;
        totalDefinitionsWorked _ totalDefinitionsWorkedCount;
        };


    DefinitionButton: PUBLIC ENTRY Menus.MenuProc = TRUSTED {
        ENABLE UNWIND => {};
        theWord, wordNoBlank: ROPE;
        DictionaryCommand: INTERNAL PROC [theWord: ROPE] = TRUSTED {
            entryHandle, item: ROPE _ NIL;
            definition: AmHerDict.Definition;
            IF interface = NIL THEN TRUSTED {
                IO.PutF[permMessage, "The dictionary server was down; I'll try to contact it again...\n"];
                interface _ AmHerDictRpcControl.ImportNewInterface[interfaceName: [instance: "DictServer"]
                    ! RPC.ImportFailed => GOTO importFailed];
                IF dictionary = NIL THEN SetDictionary[];
                IO.PutF[permMessage, "Glory be, the dictionary server is back up!\n"];
                EXITS 
                    importFailed => {
                        IO.PutF[permMessage, "Sorry, the dictionary server is still down.\n"];
                        RETURN;
                        };
                };
            IF theWord.Length[] # 0 THEN definition _ AmHerDictRpcControl.GetDefinition[interface, theWord, dictionary ! interface.LispError => 
            {IO.PutF[permMessage, "error in remote server: %g\n", IO.rope[error]]; CONTINUE}];
            IF definition.definition.Length[] # 0 THEN {
                PutWithRuns[permMessage, definition.definition, definition.looks];
                IO.PutRope[permMessage, "\n"];
                totalDefinitionsWorkedCount _ totalDefinitionsWorkedCount + 1}
            ELSE IO.PutRope[permMessage, "not found\n"];
            };
        {
            ENABLE {
                RPC.CallFailed => CHECKED {
                    SELECT why FROM
                        timeout => IO.PutF[permMessage, "The dictionary server isn't up; try again later.\n"];
                        unbound => {
                            interface _ NIL;
                            DictionaryCommand[theWord];
                            };
                        busy => IO.PutF[permMessage, "The dictionary server is busy; try again later.\n"];
                        runtimeProtocol, stubProtocol => IO.PutF[permMessage, "Screw in the RPC protocol, call a wizard.\n"];
                        ENDCASE => ERROR;
                    GOTO dictionaryBlownAway;
                    };
                UNWIND => NULL;
                };
            Locker: INTERNAL PROC [root: TiogaOpsDefs.Ref] = TRUSTED {
                ExtractOneWord: INTERNAL PROC [word: REF TEXT] RETURNS [stop: BOOLEAN _ TRUE] = TRUSTED {
                    wordNoBlank _ Rope.FromRefText[word];
                    };
                s: SpellingToolShared.Selection _ SpellingToolShared.ProcessSelection[FALSE,TRUE, TRUE].s;
                [] _ SpellingToolShared.MapWordsInSelection[s.start, s.end, ExtractOneWord, TRUE];
                IF wordNoBlank = NIL THEN 
                    IO.PutF[permMessage, "No word has been selected.\n"]
                ELSE {
                    IO.PutF[permMessage, "Looking up the definition of \"%g\"...\n", IO.rope[wordNoBlank]];
                    theWord _ wordNoBlank; -- Bug in Dictionary server requires it.
                    };
                };
            IF ~DefinitionCaveat THEN 
                IO.PutF[permMessage, "Warning: the definition facility often fails to work.\n"];
            SpellingToolShared.CorrectTiogaOpsCallWithLocks[Locker ! TiogaOps.NoSelection => {
                IO.PutF[permMessage, "No word is selected; please select a word.\n"];
                GOTO dictionaryBlownAway}];
            DefinitionCaveat _ TRUE;
            IF theWord = NIL THEN {
                IO.PutF[permMessage, "No word is selected; please select a word.\n"];
                RETURN;
                };
            totalDefinitionsCnt _ totalDefinitionsCnt + 1;
            DictionaryCommand[theWord];
            EXITS dictionaryBlownAway => NULL;
            };
        };

    }.
    <<Edited on February 26, 1985 9:29:01 pm PST, by Spreitzer>>
        <<Commented out unreachable code.>>
        <<changes to: DictionaryCommand (local of DefinitionButton)>>
    <<Spreitzer, February 25, 1986 10:59:01 pm PST>>
        <<TRUSTED SDictRpcControl.UnimportInterface[]>>
        <<changes to: FinalizeDictionaryServer>>
    <<>>