
    <<NodeStyleExtraImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Written by Bill Paxton, January 1981>>
        <<Paxton, June 3, 1983 3:35 pm>>
        <<Maxwell, January 6, 1983 10:05 am>>
        <<Russ Atkinson, March 7, 1985 3:37:01 am PST>>
        <<Paul Rovner, August 10, 1983 4:43 pm>>
        <<Plass, March 1, 1985 4:34:45 pm PST>>
        <<Doug Wyatt, March 5, 1985 10:51:57 am PST>>
    <<>>
    DIRECTORY
        Ascii,
        Atom,
        Convert,
        TJaMBasic,
        TJaMOps,
        TJaMVM,
        MessageWindow,
        NameSymbolTable,
        NodeProps,
        NodeStyle,
        NodeStyleExtra,
        NodeStyleObject,
        NodeStyleStart,
        Process,
        Rope,
        TextLooks,
        UserProfile;

    NodeStyleExtraImpl: MONITOR
    IMPORTS Ascii, Atom, Convert, TJaMOps, TJaMVM, Process, Rope, MessageWindow, NodeProps, NodeStyle, NodeStyleExtra, NameSymbolTable
    EXPORTS NodeStyle, NodeStyleExtra, NodeStyleObject, NodeStyleStart
    = BEGIN OPEN NodeStyle, NodeStyleExtra;

    <<-- Styles, StyleNames, and Frames>>

        FrameInfo: TYPE = REF FrameInfoBody;
        FrameInfoBody: TYPE = RECORD [ frame: Frame, style: Ref, rest: FrameInfo ];
        defaultStyleRope: Rope.Text;
        defaultStyleName: PUBLIC Name;
        defaultStylesForExtensions: PUBLIC LIST OF ExtObjPair;

        SetDefaultStyle: PUBLIC SAFE PROC [name: Rope.ROPE] = TRUSTED {
            defaultStyleRope _ Rope.Flatten[name];
            defaultStyleName _ ForceLower[MakeName[
                LOOPHOLE[defaultStyleRope, REF READONLY TEXT]]];
            defaultStyle.name[style] _ defaultStyleName;
            FlushCaches[];
            };

        SetExtensionStyles: PUBLIC SAFE PROC [value: LIST OF Rope.ROPE] = TRUSTED {
            ForceRopeLower: PROC [r: Rope.ROPE] RETURNS [Rope.ROPE] = TRUSTED {
                ForceCharLower: SAFE PROC [old: CHAR] RETURNS [new: CHAR] = TRUSTED {
                    RETURN [Ascii.Lower[old]] };
                RETURN [Rope.Translate[base: r, translator: ForceCharLower]] };
            defaultStylesForExtensions _ NIL;
            UNTIL value=NIL OR value.rest=NIL DO
                ext: ATOM _ Atom.MakeAtom[ForceRopeLower[value.first]]; -- the extension
                styleObject: NameSymbolTable.Object _
                    NameSymbolTable.MakeObject[LOOPHOLE[Rope.Flatten[
                        Rope.Cat["\"", ForceRopeLower[value.rest.first], "\" style"]]]];
                defaultStylesForExtensions _ CONS[[ext, styleObject], defaultStylesForExtensions];
                value _ value.rest.rest;
                ENDLOOP;
            FlushCaches[];
            };

        GetFrame: PUBLIC SAFE PROC [style: Ref, styleName: Name, kind: OfStyle]
            RETURNS [frame: Frame] = TRUSTED {
            <<-- style is the StyleRef you will be using with the frame>>
            <<-- styleName tells which style dictionary you want>>
            <<-- will give you default style if requested one bombs during load>>
            found: BOOL;
            AllocFrame: ENTRY PROC [name: Name, kind: OfStyle] = { 
                ENABLE UNWIND => NULL;
                allocFrameCalls _ allocFrameCalls+1;
                IF name # NameSymbolTable.nullName THEN {
                    <<-- first try to find one that already has the right style >>
                    IF name=styleName1 AND kind=styleKind1 AND freeFrame1 # NIL THEN
                        { frame _ freeFrame1; freeFrame1 _ NIL; RETURN };
                    IF name=styleName2 AND kind=styleKind2 AND freeFrame2 # NIL THEN
                        { frame _ freeFrame2; freeFrame2 _ NIL; RETURN };
                    IF name=styleName3 AND kind=styleKind3 AND freeFrame3 # NIL THEN
                        { frame _ freeFrame3; freeFrame3 _ NIL; RETURN };
                    IF name=styleName4 AND kind=styleKind4 AND freeFrame4 # NIL THEN
                        { frame _ freeFrame4; freeFrame4 _ NIL; RETURN }};
                <<-- look for any free one>>
                IF freeFrame1 # NIL THEN { frame _ freeFrame1; freeFrame1 _ NIL }
                ELSE IF freeFrame2 # NIL THEN { frame _ freeFrame2; freeFrame2 _ NIL }
                ELSE IF freeFrame3 # NIL THEN { frame _ freeFrame3; freeFrame3 _ NIL }
                ELSE IF freeFrame4 # NIL THEN { frame _ freeFrame4; freeFrame4 _ NIL }
                ELSE {
                    frame _ TJaMOps.NewFrame[]; frameAlloc _ frameAlloc+1;
                    TJaMOps.Begin[frame,sysdict];
                    TJaMOps.Begin[frame,styledict] }};
            SaveStyleInfo: ENTRY PROC = {
                ENABLE UNWIND => NULL;
                IF frame1 = NIL THEN { frame1 _ frame; style1 _ style }
                ELSE IF frame2 = NIL THEN { frame2 _ frame; style2 _ style }
                ELSE IF frame3 = NIL THEN { frame3 _ frame; style3 _ style }
                ELSE IF frame4 = NIL THEN { frame4 _ frame; style4 _ style }
                ELSE FOR lst: FrameInfo _ frameList, lst.rest UNTIL lst=NIL DO
                    IF lst.frame = NIL THEN { lst.frame _ frame; lst.style _ style; EXIT };
                    REPEAT FINISHED => frameList _ NEW[FrameInfoBody _ [frame,style,frameList]];
                    ENDLOOP };
            AllocFrame[styleName,kind]; -- use styleName and kind as hint about which to allocate
            IF styleName # NameSymbolTable.nullName THEN {
                <<-- get the proper style dictionary on the frame dictionary stack>>
                styleNameObj: Object;
                done: BOOL _ FALSE;
                [found,styleNameObj] _ TJaMOps.TryToLoad[frame,NameToObject[styleDictName]];
                IF found THEN { -- some style dictionary on stack already
                    IF TypeCheckName[styleNameObj]=styleName THEN { -- still must check kind of style
                        kindNameObj: Object;
                        [found,kindNameObj] _ TJaMOps.TryToLoad[frame,NameToObject[styleKindName]];
                        IF found AND TypeCheckName[kindNameObj]=kindNames[kind] THEN
                            done _ TRUE }; -- already there
                    IF ~done THEN -- get rid of top dictionary
                        WHILE TJaMOps.TopDict[frame.dictstk] # styledict DO
                            TJaMOps.End[frame]; ENDLOOP };
                IF ~done THEN TJaMOps.Begin[frame,GetStyleDict[frame,styleName,kind]] }
            ELSE WHILE TJaMOps.TopDict[frame.dictstk] # styledict DO TJaMOps.End[frame]; ENDLOOP;
            SaveStyleInfo[];
            };

    <<-- info about active frames>>

        frame1, frame2, frame3, frame4: Frame _ NIL;
        frameAlloc: INT _ 0; -- number of frames allocated from TJaM
        frameFree: INT _ 0; -- number of frames freed by TJaM
        allocFrameCalls: INT _ 0; -- number of times called AllocFrame
        freeFrameCalls: INT _ 0; -- number of times called FreeFrame. should = allocFrameCalls
        style1, style2, style3, style4: Ref;
        frameList: FrameInfo;

        debugFlag: BOOL _ TRUE;
        debugStyle: Ref;

        StyleForFrame: PUBLIC SAFE PROC [frame: Frame] RETURNS [style: Ref] = TRUSTED {
            GetIt: ENTRY PROC RETURNS [s: Ref] = INLINE {
                ENABLE UNWIND => NULL;
                SELECT frame FROM
                    frame1 => RETURN [style1];
                    frame2 => RETURN [style2];
                    frame3 => RETURN [style3];
                    frame4 => RETURN [style4];
                    ENDCASE => FOR lst: FrameInfo _ frameList, lst.rest UNTIL lst=NIL DO
                        IF lst.frame=frame THEN RETURN [lst.style];
                        ENDLOOP };
            IF (style _ GetIt[]) = NIL THEN { -- failed to find the frame
                IF debugFlag THEN {
                    IF debugStyle=NIL THEN debugStyle _ Create[];
                    RETURN [debugStyle] };
                ERROR };
            RETURN [style];
            };

    <<-- info about free frames>>

        freeFrame1, freeFrame2, freeFrame3, freeFrame4: Frame _ NIL;
        styleName1, styleName2, styleName3, styleName4: Name _ NameSymbolTable.nullName;
        styleKind1, styleKind2, styleKind3, styleKind4: OfStyle _ screen;

        FreeFrame: PUBLIC ENTRY SAFE PROC [frame: Frame, name: Name, kind: OfStyle] = TRUSTED {
            <<-- name and kind are just a hint about what style dictionary is on the frame stack>>
            ENABLE UNWIND => NULL;
            freeFrameCalls _ freeFrameCalls+1;
            <<-- add it to cache of free frames or really free it if cache full>>
            IF freeFrame1 = NIL THEN {
                freeFrame1 _ frame; styleName1 _ name; styleKind1 _ kind }
            ELSE IF freeFrame2 = NIL THEN {
                freeFrame2 _ frame; styleName2 _ name; styleKind2 _ kind }
            ELSE IF freeFrame3 = NIL THEN { 
                freeFrame3 _ frame; styleName3 _ name; styleKind3 _ kind }
            ELSE IF freeFrame4 = NIL THEN {
                freeFrame4 _ frame; styleName4 _ name; styleKind4 _ kind }
            ELSE { frameFree _ frameFree+1; TJaMOps.FreeFrame[frame] }; -- really free it
            <<-- remove it from active frame info>>
            SELECT frame FROM
                frame1 => { frame1 _ NIL; style1 _ NIL };
                frame2 => { frame2 _ NIL; style2 _ NIL };
                frame3 => { frame3 _ NIL; style3 _ NIL };
                frame4 => { frame4 _ NIL; style4 _ NIL };
                ENDCASE => FOR lst: FrameInfo _ frameList, lst.rest UNTIL lst=NIL DO
                    IF lst.frame = frame THEN { lst.frame _ NIL; lst.style _ NIL; EXIT };
                    ENDLOOP;
            };

    <<-- Local styles>>

        number: INT _ 0;
        ReadSpecsProc: SAFE PROC
            [name: ATOM, specs: Rope.ROPE] RETURNS [value: REF] = TRUSTED {
            GenLocalName: ENTRY PROC RETURNS [gen: Rope.ROPE] = {
                number _ number + 1;
                gen _ Rope.Concat["LocalStyle-", Convert.RopeFromInt[number]];
                };
            localStyle: LocalStyle _ NEW[LocalStyleRec];
            localStyleName: Rope.ROPE = GenLocalName[];
            localStyle.name _ NameSymbolTable.MakeNameFromRope[localStyleName];
            localStyle.def _ specs;
            [] _ DefineStyle[localStyle.name, specs];
            RETURN [localStyle];
            };

        WriteSpecsProc: SAFE PROC
            [name: ATOM, value: REF] RETURNS [specs: Rope.ROPE] = TRUSTED {
            localStyle: LocalStyle _ NARROW[value];
            RETURN [IF localStyle=NIL THEN NIL ELSE localStyle.def];
            };

        CopyInfoProc: SAFE PROC [name: ATOM, value: REF] RETURNS [new: REF] = 
            TRUSTED { RETURN [value] };

    <<-- Load style procedures>>

        LoadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
            frame: Frame _ GetFrame[NIL,NameSymbolTable.nullName,screen];
            [] _ GetStyleDict[frame,name,screen];
            FreeFrame[frame,NameSymbolTable.nullName,screen];
            RETURN [TRUE];
            };

        DefineStyle: PUBLIC SAFE PROC
            [name: Name, def: Rope.ROPE] RETURNS [ok: BOOL] = TRUSTED {
            frame: Frame _ GetFrame[NIL,NameSymbolTable.nullName,screen];
            IF def=NIL THEN BadStyleFile[frame,name]
            ELSE [] _ GetStyleDict[frame,name,screen,def];
            FreeFrame[frame,NameSymbolTable.nullName,screen];
            RETURN [TRUE];
            };

        ReloadStyle: PUBLIC SAFE PROC [name: Name] RETURNS [ok: BOOL] = TRUSTED {
            frame: Frame _ GetFrame[NIL,NameSymbolTable.nullName,screen];
            name _ ForceLower[name];
            ok _ RunStyle[frame,name];
            IF ~ok THEN BadStyleFile[frame,name];
            FreeFrame[frame,NameSymbolTable.nullName,screen ];
            };

        GetStyleDict: PROC [frame: Frame, name: Name, kind: OfStyle, def: Rope.ROPE _ NIL]
            RETURNS [d: dict Object] = {
            found, ok: BOOL;
            name _ ForceLower[name];
            [d, found] _ CheckStyleDict[name,kind];
            IF found THEN RETURN;
            ok _ IF def # NIL THEN RunStyleString[frame,name,def] ELSE RunStyle[frame,name];
            IF ok THEN [d,found] _ CheckStyleDict[name,kind];
            IF ~found THEN {
                BadStyleFile[frame,name];
                [d, found] _ CheckStyleDict[name,kind];
                };
            };

        BadStyleFile: PROC [frame: Frame, name: Name] = {
            <<-- fake it so looks as if had a file saying BeginStyle (default) AttachStyle EndStyle>>
            {
                ENABLE {
                    WhatStyle => { styleName _ name; RESUME };
                    StartOfStyle => RESUME;
                    EndOfStyle => RESUME;
                    };
                BeginStyleOp[frame];
                IF name # defaultStyleName THEN {
                    PushName[frame,defaultStyleName]; AttachStyleOp[frame];
                    };
                EndStyleOp[frame];
                };
            Process.Detach[FORK BadStyleMessage[name]];
            PushName[frame,name];
            PushText[frame,"style was bad."L];
            StyleError[frame,2];
            };

        BadStyleMessage: PROC [name: Name] = {
            <<-- need to fork this so to avoid monitor deadlock in viewers>>
            MessageWindow.Append[NameSymbolTable.RopeFromName[name],TRUE];
            MessageWindow.Append[".style could not be loaded."];
            };

        CreateStyleDict: PROC RETURNS [d: dict Object] = { -- creates dict for style
            RETURN [TJaMOps.Dict[50]];
            };

        EnterStyleDict: PROC [name: Name, d: Object, kind: OfStyle] = INLINE {
            TJaMOps.Put[stylesDicts[kind],NameToObject[name],d];
            };

        CheckStyleDict: PROC [name: Name, kind: OfStyle] RETURNS [d: dict Object, found: BOOL] = {
            obj: Object;
            [found,obj] _ TJaMOps.TryToGet[stylesDicts[kind],NameToObject[name]];
            IF found THEN d _ TypeCheckDict[obj];
            };

        RunStyle: PROC [frame: Frame, name: Name] RETURNS [ok: BOOL] = {
            txt: REF TEXT _ NEW[TEXT[64]];
            ext: STRING = ".style";
            txtlen: NAT;
            hasExt, started, finished: BOOL _ FALSE;
            NameSymbolTable.FromName[name,txt];
            txtlen _ txt.length;
            FOR i:NAT IN [0..txtlen) DO -- see if has an extension already
                IF txt[i] = '. THEN { hasExt _ TRUE; EXIT }; ENDLOOP;
            FOR i:NAT IN [0..ext.length) DO txt[txtlen+i] _ ext[i]; ENDLOOP;
            txt.length _ txtlen+ext.length;
            PushText[frame,LOOPHOLE[txt,LONG STRING]];
            TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]];
            TJaMOps.Execute[frame, run ! 
                WhatStyle => { styleName _ name; RESUME };
                StartOfStyle => { started _ TRUE; RESUME };
                EndOfStyle => { finished _ TRUE; RESUME };
                ];
            RETURN [started AND finished];
            };

        RunStyleString: PROC [frame: Frame, name: Name, def: Rope.ROPE]
            RETURNS [ok: BOOL] = {
            started, finished: BOOL _ FALSE;
            TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]];
            TJaMOps.Execute[frame,
                CVX[TJaMOps.MakeString[LOOPHOLE[Rope.Flatten[def],LONG STRING]]] ! 
                WhatStyle => { styleName _ name; RESUME };
                StartOfStyle => { started _ TRUE; RESUME };
                EndOfStyle => { finished _ TRUE; RESUME };
                ];
            RETURN [started AND finished];
            };


    <<-- Registered commands>>

        styleDictName: Name = MakeName["##styleDictName"];
        styleKindName: Name = MakeName["##styleKindName"];

        StartOfStyle: SIGNAL = CODE; -- raised to indicate start of loading style
        EndOfStyle: SIGNAL = CODE; -- raised to indicate successful loading
        WhatStyle: SIGNAL RETURNS [styleName: Name] = CODE; -- raised to find name of style being loaded

        ForceLower: PROC [n: Name] RETURNS [Name] = { OPEN TJaMBasic;
            nameObj: Object = NameToObject[n];
            name: name Object = WITH x:nameObj SELECT FROM name => x, ENDCASE => ERROR;
            str: string Object = TJaMOps.NameToString[name];
            force: PROC [c: CHAR] RETURNS [stop: BOOL] = {
                string[i] _ IF c IN ['A..'Z] THEN c-'A+'a ELSE c;
                i _ i+1;
                RETURN [FALSE] };
            string: STRING _ [100];
            i: CARDINAL _ 0;
            TJaMOps.StringForAll[str, force];
            string.length _ i;
            RETURN [TypeCheckName[TJaMOps.MakeName[string,name.tag]]];
            };

        BeginStyleOp: PROC [frame: Frame] = {
            name: Name _ ForceLower[SIGNAL WhatStyle]; -- get style name from RunStyle
            screenDict, printDict, baseDict: dict Object;
            ResetDict: PROC [dict: dict Object] = { TJaMOps.ClrDict[dict]; TJaMOps.DetachAll[dict] };
            MakeDict: PROC [kind: OfStyle] RETURNS [dict: dict Object] = {
                dict _ CreateStyleDict[]; EnterStyleDict[name,dict,kind] };
            InitDict: PROC [dict: dict Object, kind: OfStyle] = {
                TJaMOps.Put[baseDict,NameToObject[styleRuleDictNames[kind]],TJaMOps.Dict[50]];
                <<-- create rule name dict in baseDict>>
                TJaMOps.Put[dict,NameToObject[styleKindName],NameToObject[kindNames[kind]]];
                <<-- record the style kind>>
                };
            found: BOOL;
            [baseDict,found] _ CheckStyleDict[name,base]; -- check if reloading
            IF found THEN {
                ResetDict[baseDict];
                [printDict,] _ CheckStyleDict[name,print];
                ResetDict[printDict];
                [screenDict,] _ CheckStyleDict[name,screen];
                ResetDict[screenDict];
                FlushCaches[] }
            ELSE {
                baseDict _ MakeDict[base];
                screenDict _ MakeDict[screen];
                printDict _ MakeDict[print] };
            InitDict[baseDict,base]; InitDict[screenDict,screen]; InitDict[printDict,print];

            TJaMOps.AttachDict[screenDict,baseDict];
            TJaMOps.AttachDict[printDict,baseDict];

            TJaMOps.Put[baseDict,NameToObject[styleDictNames[screen]],screenDict];
            TJaMOps.Put[baseDict,NameToObject[styleDictNames[print]],printDict];
            TJaMOps.Put[baseDict,NameToObject[styleDictNames[base]],baseDict];

            TJaMOps.Put[baseDict,NameToObject[styleDictName],NameToObject[name]];

            TJaMOps.Begin[frame,baseDict];
            PushObject[frame,baseDict]; -- leave this around for EndStyleOp
            SIGNAL StartOfStyle; -- caught by RunStyle
            };

        StyleName: PROC [frame: Frame] = { -- expects style dictionary on op stack
            PushObject[frame,TJaMOps.Load[frame,NameToObject[styleDictName]]]
            };

        EndStyleOp: PROC [frame: Frame] = {
            d1, d2: dict Object;
            d1 _ TJaMOps.TopDict[frame.dictstk]; -- the current dictionary
            d2 _ TJaMOps.PopDict[frame.opstk]; -- pushed by StyleOp
            IF d1 # d2 THEN {
                PushText[frame,"mismatched Style and EndStyle commands"L];
                StyleError[frame,1] }
            ELSE { -- change attachments so look in own basicDict before any attached dicts
                name: Name _ SIGNAL WhatStyle;
                screenDict: dict Object = CheckStyleDict[name,screen].d;
                printDict: dict Object = CheckStyleDict[name,print].d;
                TJaMOps.DetachDict[screenDict,d1];
                TJaMOps.DetachDict[printDict,d1];
                TJaMOps.AttachDict[screenDict,d1];
                TJaMOps.AttachDict[printDict,d1];
                TJaMOps.End[frame] };
            SIGNAL EndOfStyle; -- caught by RunStyle
            };

        styleRuleDictNames: REF ARRAY OfStyle OF Name = NEW[ARRAY OfStyle OF Name];
        styleDictNames: REF ARRAY OfStyle OF Name = NEW[ARRAY OfStyle OF Name];

        StyleRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,base] };

        PrintRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,print] };

        ScreenRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame,screen] };

        DefineStyleRule: PROC [frame: Frame, kind: OfStyle] = {
            <<expects <name> <comment> <definition> on op stack>>
            definition: Object _ PopObject[frame];
            comment: Object _ PopObject[frame];
            STKname: Name _ PopName[frame];
            name: Name _ ForceLower[STKname];
            nameObj: Object _ NameToObject[name];
            dict: dict Object _ LoadStyleDict[frame,kind];
            WITH x:definition SELECT FROM
                array => TJaMOps.ABind[x,bindingDict];
                ENDCASE; -- def may be a string
            TJaMOps.Put[dict,nameObj,CVX[definition]]; -- save the definition
            IF name#STKname THEN TJaMOps.Put[dict,NameToObject[STKname],CVX[definition]];
            TJaMOps.Put[LoadStyleRuleDict[frame,kind],nameObj,comment]; -- save the comment in the rule name dict
            };

        LoadStyleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = {
            RETURN [TypeCheckDict[TJaMOps.Load[frame,NameToObject[styleDictNames[kind]]]]];
            };

        LoadStyleRuleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = {
            RETURN [TypeCheckDict[TJaMOps.Load[frame,NameToObject[styleRuleDictNames[kind]]]]];
            };

        OpenStyle: PROC [frame: Frame, kind: OfStyle] = {
            name: Name _ PopName[frame];
            IF ~LoadStyle[name] THEN RETURN;
            WHILE TJaMOps.TopDict[frame.dictstk] # sysdict DO TJaMOps.End[frame]; ENDLOOP;
            TJaMOps.Begin[frame,styledict];
            TJaMOps.Begin[frame,GetStyleDict[frame,name,kind]];
            };

        OpenPrintStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
            OpenStyle[frame, print];
            };

        OpenScreenStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
            OpenStyle[frame, screen];
            };

        ResetTestStyle: PROC [frame: Frame] = { 
            IF debugStyle=NIL THEN debugStyle _ Create[];
            debugStyle^ _ defaultStyle^;
            };

        StyleRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,base] };

        PrintRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,print] };

        ScreenRuleDict: PROC [frame: Frame] = { GetRuleDict[frame,screen] };

        GetRuleDict: PROC [frame: Frame, kind: OfStyle] = {
            PushName[frame,styleRuleDictNames[kind]];
            TJaMOps.Execute[frame,get];
            };

        ForEachAttachedStyle: PUBLIC SAFE PROC [
            dictName: Name, proc: PROC [attached: Name] RETURNS [stop: BOOL]] = TRUSTED {
            val: Object;
            array: array Object;
            found: BOOL;
            dictName _ ForceLower[dictName];
            [found,val] _ TJaMOps.TryToGet[attachmentsDict, NameToObject[dictName]];
            IF ~found THEN RETURN;
            WITH val:val SELECT FROM
                array => array _ val;
                ENDCASE => ERROR;
            FOR i: CARDINAL IN [0..array.length) DO
                ob: Object _ TJaMVM.GetElem[array,i];
                IF proc[TypeCheckName[ob]] THEN RETURN;
                ENDLOOP;
            };

        AttachStyleOp: PROC [frame: Frame] = { -- expects opstk to contain style name
            name: Name _ ForceLower[PopName[frame]];
            found: BOOL;
            printDict, screenDict: dict Object;
            array: array Object;
            styleName: Name _ SIGNAL WhatStyle;
            val: Object;
            [printDict,found] _ CheckStyleDict[name,print];
            IF ~found THEN {
                IF RunStyle[frame,name] THEN [printDict,found] _ CheckStyleDict[name,print];
                IF ~found THEN {
                    BadStyleFile[frame,name];
                    RETURN }};
            [screenDict,found] _ CheckStyleDict[name,screen];
            IF ~found THEN ERROR;
            TJaMOps.AttachDict[LoadStyleDict[frame,screen],screenDict];
            TJaMOps.AttachDict[LoadStyleDict[frame,print],printDict];
            [found,val] _ TJaMOps.TryToGet[attachmentsDict, NameToObject[styleName]];
            IF ~found THEN array _ TJaMOps.Array[1] -- this is the first attachment
            ELSE { -- add new item to the array
                WITH val:val SELECT FROM
                    array => array _ val;
                    ENDCASE => ERROR;
                array _ TJaMOps.ACopy[array,1] };
            TJaMOps.APut[array,array.length-1,NameToObject[name]];
            TJaMOps.Put[attachmentsDict, NameToObject[styleName], array];
            };

        ClearTabStopsOp: PROC [frame: Frame] = {
            ref: Ref _ StyleForFrame[frame];
            ref.tabStops _ NIL; ref.numTabStops _ 0;
            };

    <<-- support procs>>

        PushText: PUBLIC SAFE PROC [frame: Frame, txt: LONG STRING] = TRUSTED {
            TJaMOps.Push[frame.opstk,TJaMOps.MakeString[txt]];
            };

        PushObject: PUBLIC SAFE PROC [frame: Frame, ob: Object] = TRUSTED {
            TJaMOps.Push[frame.opstk,ob];
            };

        PopObject: PUBLIC SAFE PROC [frame: Frame] RETURNS [Object] = TRUSTED {
            RETURN[TJaMOps.Pop[frame.opstk]];
            };

        PushName: PUBLIC SAFE PROC [frame: Frame, name: Name] = TRUSTED {
            TJaMOps.Push[frame.opstk,NameToObject[name]];
            };

        stringToNameCount: LONG INTEGER _ 0; -- for debugging

        PopName: PUBLIC SAFE PROC [frame: Frame] RETURNS [Name] = TRUSTED {
            obj: Object _ TJaMOps.Pop[frame.opstk];
            WITH x:obj SELECT FROM
                name => RETURN [LOOPHOLE[x.id]];
                string => {
                    nameObj: name Object _ TJaMOps.StringToName[x];
                    stringToNameCount _ stringToNameCount+1;
                    RETURN [LOOPHOLE[nameObj.id]] };
                ENDCASE => {
                    PushText[frame," -- found where expected a name"L];
                    PushObject[frame,obj];
                    StyleError[frame,2] };
            ERROR;
            };

        TryToPopReal: PUBLIC SAFE PROC [frame: Frame] RETURNS [value: Real, ok: BOOL] = TRUSTED {
            obj: Object;
            IF frame.opstk.head = NIL THEN RETURN [0.0, FALSE];
            obj _ TJaMOps.Top[frame.opstk];
            WITH x:obj SELECT FROM
                integer => { [] _ PopObject[frame]; RETURN [x.ivalue, TRUE] };
                real => { [] _ PopObject[frame]; RETURN [x.rvalue, TRUE] };
                ENDCASE => RETURN [0.0, FALSE];
            };

        TryToPopString: PUBLIC SAFE PROC [frame: Frame]
            RETURNS [string: string TJaMBasic.Object, ok: BOOL] = TRUSTED {
            obj: Object;
            IF frame.opstk.head = NIL THEN { ok _ FALSE; RETURN };
            obj _ TJaMOps.Top[frame.opstk];
            WITH x:obj SELECT FROM
                name => { [] _ PopObject[frame]; RETURN [TJaMOps.NameToString[x], TRUE] };
                string => { [] _ PopObject[frame]; RETURN [x, TRUE] };
                ENDCASE => ok _ FALSE;
            };

        TryToPopName: PUBLIC SAFE PROC [frame: Frame] RETURNS [name: Name, ok: BOOL] = TRUSTED {
            obj: Object;
            IF frame.opstk.head = NIL THEN RETURN [NameSymbolTable.nullName,FALSE];
            obj _ TJaMOps.Top[frame.opstk];
            WITH x:obj SELECT FROM
                name => { [] _ PopObject[frame]; RETURN [LOOPHOLE[x.id],TRUE] };
                string => {
                    nameObj: name Object _ TJaMOps.StringToName[x];
                    stringToNameCount _ stringToNameCount+1;
                    [] _ PopObject[frame];
                    RETURN [LOOPHOLE[nameObj.id],TRUE] };
                ENDCASE => RETURN [NameSymbolTable.nullName,FALSE];
            };

        TypeCheckName: PUBLIC SAFE PROC [obj: Object] RETURNS [Name] = TRUSTED {
            WITH x:obj SELECT FROM
                name => RETURN [LOOPHOLE[x.id]];
                string => {
                    nameObj: name Object _ TJaMOps.StringToName[x];
                    stringToNameCount _ stringToNameCount+1;
                    RETURN [LOOPHOLE[nameObj.id]] };
                ENDCASE;
            ERROR;
            };

        TypeCheckDict: PUBLIC SAFE PROC
            [obj: Object] RETURNS [dict Object] = TRUSTED {
            WITH x:obj SELECT FROM
                dict => RETURN [x];
                ENDCASE;
            ERROR;
            };

        TypeCheckCommand: PUBLIC SAFE PROC
            [obj: Object] RETURNS [command Object] = TRUSTED {
            WITH x:obj SELECT FROM
                command => RETURN [x];
                ENDCASE;
            ERROR;
            };

    <<-- Initialization>>

        StyleCommand: PUBLIC SAFE PROC
            [frame: Frame, text: REF READONLY TEXT, proc: PROC [Frame]] 
            RETURNS [name: Name]= TRUSTED {
            name _ MakeName[text];
            TJaMOps.RegisterExplicit[frame,LOOPHOLE[text,LONG STRING],proc];
            <<-- add it to the binding dictionary>>
            TJaMOps.Put[bindingDict,NameToObject[name],
                CVX[TJaMOps.Load[frame,NameToObject[name]]]];
            };

        StyleLiteral: PUBLIC SAFE PROC
            [frame: Frame, text: REF READONLY TEXT] RETURNS [name: Name] = TRUSTED {
            name _ MakeName[text];
            <<-- add it to the binding dictionary>>
            TJaMOps.Put[bindingDict,NameToObject[name],CVLit[NameToObject[name]]];
            <<-- add it to the current dictionary>>
            TJaMOps.Def[frame,NameToObject[name],CVLit[NameToObject[name]]];
            };

        InitDict: PROC [txt: REF READONLY TEXT, size: CARDINAL _ 100]
            RETURNS [name: Name, dictionary: dict Object] = {
            found: BOOL;
            d: Object;
            name _ MakeName[txt];
            [found,d] _ TJaMOps.TryToGet[sysdict,NameToObject[name]];
            IF found THEN dictionary _ TypeCheckDict[d]
            ELSE {
                dictionary _ TJaMOps.Dict[size];
                TJaMOps.Put[sysdict,NameToObject[name],dictionary];
                }
            };

        bindingDictName, attachmentsDictName, styledictName: Name;

        bindingDict, attachmentsDict: dict Object;

        stylesDictsNames: REF ARRAY OfStyle OF Name _ NEW[ARRAY OfStyle OF Name];
        stylesDictNames: REF ARRAY OfStyle OF Name _ NEW[ARRAY OfStyle OF Name];

        stylesDicts: REF ARRAY OfStyle OF dict Object _ NEW[ARRAY OfStyle OF dict Object];

        InitStylesDict: PROC = {
            [stylesDictsNames[base], stylesDicts[base]] _ InitDict["TiogaBaseStylesDictionary"];
            [stylesDictsNames[print], stylesDicts[print]] _ InitDict["TiogaPrintStylesDictionary"];
            [stylesDictsNames[screen], stylesDicts[screen]] _ InitDict["TiogaScreenStylesDictionary"];
            };

        InitBindingDict: PROC = {
            [bindingDictName, bindingDict] _ InitDict["TiogaBindingDictionary",200];
            };

        InitAttachmentsDict: PROC = {
            [attachmentsDictName, attachmentsDict] _ InitDict["TiogaAttachedStylesDictionary"];
            };

        InitStyleDict: PROC = {
            [styledictName, styledict] _ InitDict["TiogaStylesDictionary"];
            TJaMOps.AttachDict[styledict,userdict];
            };

        RegCom: PROC [frame: Frame, txt: REF READONLY TEXT, proc: PROC[Frame]]
            RETURNS [c: command Object] = {
            TJaMOps.RegisterExplicit[frame,LOOPHOLE[txt,LONG STRING],proc];
            c _ GetCommand[frame,MakeName[txt]];
            };

        sysdict, userdict, styledict: PUBLIC dict Object;

        styleerror: PUBLIC Name;

        GetCommand: PUBLIC SAFE PROC [frame: Frame, name: Name]
            RETURNS [command Object] = TRUSTED {
            flag: BOOL;
            obj: Object;
            [flag,obj] _ TJaMOps.TryToLoad[frame,NameToObject[name]];
            IF ~flag THEN ERROR;
            RETURN [TypeCheckCommand[obj]];
            };

        GetObject: PROC [frame: Frame, name: Name] RETURNS [ob: Object] = {
            RETURN [TJaMOps.Load[frame,NameToObject[name]]];
            };

        ReportStyleError: PROC [frame: Frame] = {
            num: CARDINAL _ TJaMOps.PopCardinal[frame.opstk];
            string: string TJaMBasic.Object;
            ok: BOOL;
            MessageWindow.Clear[];
            IF executingName # NameSymbolTable.nullName THEN {
                PushText[frame,"style rule. "L];
                PushName[frame,executingName];
                PushText[frame,"Error in"L];
                num _ num+3;
                };
            UNTIL num=0 DO
                GetChar: SAFE PROC RETURNS [c: CHAR] = TRUSTED
                    { c _ TJaMVM.GetChar[string, i];  i _ i+1 };
                i: CARDINAL;
                [string, ok] _ TryToPopString[frame];
                IF ~ok THEN EXIT;
                i _ 0;
                MessageWindow.Append[Rope.FromProc[string.length, GetChar]];
                num _ num-1;
                IF num # 0 THEN MessageWindow.Append[" "];
                ENDLOOP;
            };

        RunFile: PROC [frame: Frame, name: Name, dictname: LONG STRING]
            RETURNS [BOOL] = {
            known: BOOL;
            [known,] _ TJaMOps.TryToLoad[frame,NameToObject[name]];
            IF known THEN RETURN [FALSE];
            PushText[frame,dictname];
            TJaMOps.Execute[frame,run];
            RETURN [TRUE];
            };

        load, get, run: PUBLIC command Object;

        kindNames: REF ARRAY OfStyle OF Name _ NEW[ARRAY OfStyle OF Name];

        startCount: CARDINAL _ 0;

        StartExtra: PUBLIC SAFE PROC = TRUSTED {
            frame, frame1, frame2, frame3, frame4: Frame _ NIL;
            topDictName: Name;

            IF (startCount _ startCount+1)>1 THEN RETURN;

            frame _ TJaMOps.defaultFrame;

            get _ GetCommand[frame,MakeName[".get"]];
            run _ GetCommand[frame,MakeName[".run"]];
            load _ GetCommand[frame,MakeName[".load"]];

            sysdict _ TypeCheckDict[GetObject[frame,MakeName[".sysdict"]]];

            <<-- check if have done (start.jam) .run>>
            IF ~RunFile[frame,MakeName["user"],"start.jam"] THEN
                TJaMOps.Execute[frame,CVX[NameToObject[MakeName[".start"]]]];

            userdict _ TJaMOps.TopDict[frame.dictstk];
            InitStyleDict[];
            TJaMOps.End[frame]; -- replace userdict by styledict for rest of startup
            TJaMOps.Begin[frame,styledict];

            topDictName _ MakeName["topDictName"];
            TJaMOps.Put[sysdict,NameToObject[topDictName],NameToObject[MakeName[".sysdict"]]];
            TJaMOps.Put[userdict,NameToObject[topDictName],NameToObject[MakeName["userdict"]]];
            TJaMOps.Put[styledict,NameToObject[topDictName],
                NameToObject[MakeName["TiogaStylesDictionary"]]];

            styleerror _ MakeName["StyleError"];

            kindNames[screen] _ MakeName["screen"];
            kindNames[print] _ MakeName["print"];
            kindNames[base] _ MakeName["base"];

            styleRuleDictNames[base] _ MakeName["##BaseStyleRuleDictName"];
            styleRuleDictNames[screen] _ MakeName["##ScreenStyleRuleDictName"];
            styleRuleDictNames[print] _ MakeName["##PrintStyleRuleDictName"];

            styleDictNames[base] _ MakeName["##BaseStyleDictName"];
            styleDictNames[screen] _ MakeName["##ScreenStyleDictName"];
            styleDictNames[print] _ MakeName["##PrintStyleDictName"];

            InitStylesDict[]; InitBindingDict[]; InitAttachmentsDict[];

            <<-- check if have done (TiogaUtils.jam) .run>>
            [] _ RunFile[frame,styleerror,"TiogaUtils.jam"];

            [] _ RegCom[frame,"ReportStyleError",ReportStyleError];
            [] _ RegCom[frame,"StyleName",StyleName];
            [] _ RegCom[frame,"StyleRuleDict",StyleRuleDict];
            [] _ RegCom[frame,"PrintRuleDict",PrintRuleDict];
            [] _ RegCom[frame,"ScreenRuleDict",ScreenRuleDict];
            [] _ RegCom[frame,"OpenPrintStyle",OpenPrintStyleOp];
            [] _ RegCom[frame,"OpenScreenStyle",OpenScreenStyleOp];
            [] _ RegCom[frame,"ResetTestStyle",ResetTestStyle];

            [] _ StyleCommand[frame,"BeginStyle",BeginStyleOp];
            [] _ StyleCommand[frame,"EndStyle",EndStyleOp];
            [] _ StyleCommand[frame,"StyleRule",StyleRuleOp];
            [] _ StyleCommand[frame,"PrintRule",PrintRuleOp];
            [] _ StyleCommand[frame,"ScreenRule",ScreenRuleOp];
            [] _ StyleCommand[frame,"AttachStyle",AttachStyleOp];

            <<-- style commands for tabs>>
            [] _ StyleCommand[frame,"clearTabStops",ClearTabStopsOp];
            [] _ StyleCommand[frame,"tabStop",TabStopOp];
            [] _ StyleCommand[frame,"defaultTabStops",DefaultTabStopsOp];
            [] _ StyleCommand[frame,"tabStopLocations",RelativeTabStopsOp];

            <<-- allocate and free some frames to initialize the cache>>
            frame1 _ GetFrame[NIL, NameSymbolTable.nullName, screen];
            frame2 _ GetFrame[NIL, NameSymbolTable.nullName, screen];
            frame3 _ GetFrame[NIL, NameSymbolTable.nullName, screen];
            frame4 _ GetFrame[NIL, NameSymbolTable.nullName, screen];
            FreeFrame[frame1, NameSymbolTable.nullName, screen];
            FreeFrame[frame2, NameSymbolTable.nullName, screen];
            FreeFrame[frame3, NameSymbolTable.nullName, screen];
            FreeFrame[frame4, NameSymbolTable.nullName, screen];

            NodeProps.Register[name: $StyleDef, 
            reader: ReadSpecsProc, writer: WriteSpecsProc, copier: CopyInfoProc];

            };

StartExtra[];

    END.