
    <<NodePropsImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<written by Paxton.  January 1981>>
        <<Doug Wyatt, March 3, 1985 5:40:46 pm PST>>
        <<Michael Plass, May 9, 1986 11:55:53 am PDT>>
        <<Rick Beach, March 28, 1985 9:57:47 am PST>>
        <<Russ Atkinson (RRA) August 19, 1985 4:17:41 pm PDT>>
        <<>>
    DIRECTORY
        Atom USING [DottedPairNode, GetPName, MakeAtom, PropList],
        Basics USING [BoundsCheckHighHalf, DoubleShiftLeft, NonNegative],
        IO USING [atom, int, PutFR],
        List USING [Length, Sort],
        MessageWindow USING [Append, Blink],
        NodeProps USING [CopyInfoProc, MapPropsAction, ReadSpecsProc, WriteSpecsProc],
        NodePropsExtras USING [],
        RefTab USING [Create, Fetch, Ref, Store],
        Rope USING [Concat, Equal, Fetch, FromChar, FromRefText, IsEmpty, ROPE, Size, Substr],
        Rosary USING [FromProcProc, MapRuns, ROSARY, Size],
        TextNode USING [NodeProps, NodePropsBody, Ref];

    NodePropsImpl: CEDAR MONITOR
    IMPORTS Atom, Basics, IO, List, MessageWindow, RefTab, Rope, Rosary
    EXPORTS TextNode, NodeProps, NodePropsExtras
    ~ BEGIN

        ROSARY: TYPE = Rosary.ROSARY;
        ROPE: TYPE = Rope.ROPE;
        Object: TYPE = REF;

        CopyInfoProc: TYPE = NodeProps.CopyInfoProc;
        MapPropsAction: TYPE = NodeProps.MapPropsAction;
        ReadSpecsProc: TYPE = NodeProps.ReadSpecsProc;
        WriteSpecsProc: TYPE = NodeProps.WriteSpecsProc;

        Prop, Props: TYPE = REF NodePropsBody;
        NodePropsBody: PUBLIC TYPE = RECORD [
            name: ATOM, -- name of the property
            value: REF,
            next: Props -- points to next property
            ];

        charsetsAtom: ATOM = $CharSets;
        charpropsAtom: ATOM = $CharProps;
        artworkAtom: ATOM = $Artwork;

        commentAtom: ATOM = $Comment;
        formatAtom: ATOM = $Format;
        styleDefAtom: ATOM = $StyleDef;
        prefixAtom: ATOM = $Prefix;
        postfixAtom: ATOM = $Postfix;
        true: PUBLIC REF BOOL _ NEW[BOOL _ TRUE];
        false: PUBLIC REF BOOL _ NEW[BOOL _ FALSE];

        ReadComment: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
            RETURN [IF Rope.Equal[specs, "TRUE", FALSE] THEN true ELSE false] 
            };

        WriteComment: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ {
            WITH value SELECT FROM
                x: REF BOOL => IF x^ THEN specs _ "TRUE";
                ENDCASE => specs _ "FALSE"; 
            };

        ReadFormat: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF _ NIL] ~ {
            IF NOT Rope.IsEmpty[specs] THEN value _ Atom.MakeAtom[specs];
            };

        WriteFormat: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE _ NIL] ~ {
            WITH value SELECT FROM
                atom: ATOM => specs _ Atom.GetPName[NARROW[atom]];
                ENDCASE;
            };

        ReadPfix: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
            RETURN [specs] 
            };

        WritePfix: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE _ NIL] ~ {
            WITH value SELECT FROM
                rope: ROPE => specs _ rope;
                ENDCASE;
            };

        ReadCharSets: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
            <<Raises a bounds fault if invalid specs are provided.>>
            <<Encoding is (<repeatCount><charSet>)*, where <repeatCount> is encoded with the variable-length integer encoding scheme described 
            in FileOps, and <charSet> is just encoded as a byte.>>
            p: PROC [q: PROC [REF, INT]] ~ {
                i: INT _ 0;
                size: INT _ Rope.Size[specs];
                GetByte: PROC RETURNS [b: [0..256)] ~ {b _ Rope.Fetch[specs, i]-'\000; i _ i + 1};
                Combine: PROC [a: INT, b: [0..128)] RETURNS [INT] ~ {
                    bnd: NAT ~ LAST[NAT]/128+1;
                    RETURN [Basics.DoubleShiftLeft[[li[Basics.BoundsCheckHighHalf[a, bnd]]], 7].li + b];
                    };
                GetInt: PROC RETURNS [int: INT _ 0] ~ {
                    b: [0..256) _ GetByte[];
                    WHILE b > 127 DO
                        int _ Combine[int, b-128];
                        b _ GetByte[];
                        ENDLOOP;
                    int _ Combine[int, b];
                    };
                UNTIL i = size DO
                    repeat: INT ~ GetInt[];
                    charSet: [0..256) ~ GetByte[];
                    IF charSet=0 THEN q[NIL, repeat] ELSE q[NEW[[0..256) _ charSet], repeat];
                    ENDLOOP;
                };
            RETURN [Rosary.FromProcProc[p]];
            };

        WriteCharSets: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE _ NIL] ~ {
            text: REF TEXT ~ NEW[TEXT[48]];
            Fold: PROC ~ {specs _ Rope.Concat[specs, Rope.FromRefText[text]]; text.length _ 0};
            PutByte: PROC [b: [0..256)] ~ {
                IF text.length = text.maxLength THEN Fold[];
                text[text.length] _ VAL[b];
                text.length _ text.length + 1;
                };
            PutInt: PROC [int: INT, more: BOOLEAN _ FALSE] ~ {
                IF int > 127 THEN {PutInt[int/128, TRUE]; int _ int MOD 128};
                IF more THEN int _ int + 128;
                PutByte[int];
                };
            charSet: [0..256) _ 0;
            charSetRepeat: INT _ 0;
            FlushRun: PROC ~ {
                IF charSetRepeat > 0 THEN {PutInt[charSetRepeat]; PutByte[charSet]; charSetRepeat _ 0};
                };
            Action: PROC [item: REF, repeat: INT] RETURNS [quit: BOOL _ FALSE] ~ {
                new: [0..256) _ WITH item SELECT FROM
                    r: REF [0..256) => r^,
                    ENDCASE => 0;
                IF charSetRepeat > 0 AND new#charSet THEN FlushRun[];
                charSet _ new;
                charSetRepeat _ charSetRepeat + repeat;
                };
            [] _ Rosary.MapRuns[[NARROW[value]], Action];
            FlushRun[];
            Fold[];
            IF Rope.Size[specs] = 0 THEN specs _ NIL;
            };

        ReadCharProps: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
            <<Raises a bounds fault if invalid specs are provided.>>
            <<Encoding is>>
                <<(<repeatCount><propsCount>(<atomLen><atomBytes><valueLen><valueBytes>)*)*,>>
            <<where the counts and lengths are encoded with the variable-length integer encoding scheme described in FileOps.>>
            p: PROC [q: PROC [REF, INT]] ~ {
                i: INT _ 0;
                size: INT _ Rope.Size[specs];
                GetByte: PROC RETURNS [b: [0..256)] ~ {b _ Rope.Fetch[specs, i]-'\000; i _ i + 1};
                Combine: PROC [a: INT, b: [0..128)] RETURNS [INT] ~ {
                    bnd: NAT ~ LAST[NAT]/128+1;
                    RETURN [Basics.DoubleShiftLeft[[li[Basics.BoundsCheckHighHalf[a, bnd]]], 7].li + b];
                    };
                GetInt: PROC RETURNS [int: INT _ 0] ~ {
                    b: [0..256) _ GetByte[];
                    WHILE b > 127 DO
                        int _ Combine[int, b-128];
                        b _ GetByte[];
                        ENDLOOP;
                    int _ Combine[int, b];
                    };
                GetRope: PROC RETURNS [rope: ROPE _ NIL] ~ {
                    len: INT ~ GetInt[];
                    rope _ Rope.Substr[specs, i, len];
                    i _ i + len;
                    [] _ Basics.NonNegative[size-i];
                    };
                UNTIL i = size DO
                    repeatCount: INT ~ GetInt[];
                    propsCount: INT ~ GetInt[];
                    propList: Atom.PropList _ NIL;
                    THROUGH [0..propsCount) DO
                        atom: ATOM ~ Atom.MakeAtom[GetRope[]];
                        valueSpecs: ROPE ~ GetRope[];
                        value: REF ~ DoSpecs[atom, valueSpecs];
                        propList _ CONS[NEW[Atom.DottedPairNode _ [key: atom, val: value]], propList];
                        ENDLOOP;
                    q[propList, repeatCount];
                    ENDLOOP;
                };
            RETURN [Rosary.FromProcProc[p]];
            };

        WriteCharProps: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE _ NIL] ~ {
            curRope: ROPE _ NIL;
            Grab: PROC RETURNS [rope: ROPE] ~ {rope _ curRope; curRope _ NIL};
            PutByte: PROC [b: [0..256)] ~ {curRope _ Rope.Concat[curRope, Rope.FromChar[VAL[b]]]};
            PutRope: PROC [rope: ROPE] ~ {curRope _ Rope.Concat[curRope, rope]};
            PutInt: PROC [int: INT, more: BOOLEAN _ FALSE] ~ {
                IF int > 127 THEN {PutInt[int/128, TRUE]; int _ int MOD 128};
                IF more THEN int _ int + 128;
                PutByte[int];
                };
            rept: INT _ 0;
            itemSpecs: ROPE _ NIL;
            FlushRun: PROC ~ { IF rept > 0 THEN {PutInt[rept]; PutRope[itemSpecs]; rept _ 0} };
            PutItem: PROC [newItemSpecs: ROPE, repeat: INT] ~ {
                IF NOT Rope.Equal[newItemSpecs, itemSpecs] THEN FlushRun[];
                itemSpecs _ newItemSpecs;
                rept _ rept + repeat;
                };
            Action: PROC [item: REF, repeat: INT] RETURNS [quit: BOOL _ FALSE] ~ {
                save: ROPE ~ Grab[];
                SpecsList: PROC [propList: Atom.PropList] RETURNS [s: LIST OF REF _ NIL] ~ {
                    FOR p: Atom.PropList _ propList, p.rest UNTIL p = NIL DO
                        atom: ATOM ~ NARROW[p.first.key];
                        v: ROPE ~ GetSpecs[atom, p.first.val];
                        IF v # NIL THEN {
                            a: ROPE ~ Atom.GetPName[atom];
                            PutInt[Rope.Size[a]]; PutRope[a]; PutInt[Rope.Size[v]]; PutRope[v];
                            s _ CONS[Grab[], s];
                            };
                        ENDLOOP;
                    };
                specList: LIST OF REF _ List.Sort[SpecsList[NARROW[item]]];
                newItemSpecs: ROPE;
                PutInt[List.Length[specList]];
                UNTIL specList = NIL DO
                    t: LIST OF REF _ specList;
                    PutRope[NARROW[t.first]];
                    specList _ t.rest;
                    t.rest _ NIL;
                    ENDLOOP;
                newItemSpecs _ Grab[];
                curRope _ save;
                PutItem[newItemSpecs, repeat];
                };
            [] _ Rosary.MapRuns[[NARROW[value]], Action];
            FlushRun[];
            specs _ Grab[];
            IF Rope.Size[specs] = 0 THEN specs _ NIL;
            };

        FindName: PROC [n: TextNode.Ref, name: ATOM, remove: BOOL] RETURNS [prop: Prop] ~ {
            lst, prev: Props;
            IF n=NIL THEN RETURN [NIL];
            lst _ n.props;
            prop _ NIL; prev _ NIL;
            WHILE lst#NIL DO
                IF lst.name = name THEN { prop _ lst; EXIT };
                prev _ lst;  lst _ lst.next;
                ENDLOOP;
            IF prop#NIL AND remove THEN
            IF prev#NIL THEN prev.next _ prop.next
                ELSE n.props _ prop.next 
            };

        PutProp: PUBLIC PROC [n: TextNode.Ref, name: ATOM, value: REF] ~ {
            prop: Prop _ FindName[n, name, FALSE];
            IF name = charpropsAtom OR name = charsetsAtom THEN {
                value _ CheckRosarySize[NARROW[value], n, name];
                };
            IF value = NIL THEN {
                IF prop#NIL THEN prop.value _ NIL;
                SELECT name FROM
                    styleDefAtom => n.hasstyledef _ FALSE;
                    prefixAtom => n.hasprefix _ FALSE;
                    postfixAtom => n.haspostfix _ FALSE;
                    formatAtom => n.formatName _ NIL;
                    commentAtom => n.comment _ FALSE;
                    charpropsAtom => n.hascharprops _ FALSE;
                    charsetsAtom => n.hascharsets _ FALSE;
                    artworkAtom => n.hasartwork _ FALSE;
                    ENDCASE;
                RETURN 
                };
            SELECT name FROM
                styleDefAtom => n.hasstyledef _ TRUE;
                prefixAtom => { n.hasprefix _ TRUE };
                postfixAtom => { n.haspostfix _ TRUE };
                formatAtom => {
                    n.formatName _ NARROW[value];
                    RETURN;
                    };
                commentAtom => { -- simply set the bit in the node
                    n.comment _ NARROW[value, REF BOOL]^;
                    RETURN;
                    };
                charpropsAtom => n.hascharprops _ TRUE;
                charsetsAtom => n.hascharsets _ TRUE;
                artworkAtom => n.hasartwork _ TRUE;
                ENDCASE;
            IF prop#NIL THEN { prop.value _ value; RETURN };
            n.props _ NEW[NodePropsBody _ [name: name, value: value, next: n.props]];
            };

        CheckRosarySize: PROC [rosary: ROSARY, n: TextNode.Ref, what: ATOM]
        RETURNS [ROSARY] ~ {
            IF rosary # NIL THEN {
                rosarySize: INT ~ Rosary.Size[rosary];
                ropeSize: INT ~ Rope.Size[n.rope];
                IF rosarySize # ropeSize THEN {
                    msg: ROPE ~ IO.PutFR["NodePropsImpl: %g property discarded because its size (%g) differed from rope size (%g).", IO.atom[what], 
                    IO.int[rosarySize], IO.int[ropeSize]];
                    MessageWindow.Append[msg, TRUE];
                    MessageWindow.Blink[];
                    RETURN [NIL];
                    };
                };
            RETURN [rosary];
            };

        GetProp: PUBLIC PROC [n: TextNode.Ref, name: ATOM] RETURNS [value: REF] ~ {
            prop: Prop _ FindName[n, name, FALSE];
            IF prop # NIL THEN
                value _ prop.value
            ELSE IF name = commentAtom THEN
                value _ IF n # NIL AND n.comment THEN true ELSE false
            ELSE IF name = formatAtom THEN
                value _ IF n.formatName = NIL THEN NIL ELSE n.formatName;
            };

        RemProp: PUBLIC PROC [n: TextNode.Ref, name: ATOM] ~ {
            [] _ FindName[n, name, TRUE]; -- removes the value
            SELECT name FROM
                styleDefAtom => n.hasstyledef _ FALSE;
                prefixAtom => n.hasprefix _ FALSE;
                postfixAtom => n.haspostfix _ FALSE;
                formatAtom => n.formatName _ NIL;
                commentAtom => n.comment _ FALSE;
                charpropsAtom => n.hascharprops _ FALSE;
                charsetsAtom => n.hascharsets _ FALSE;
                artworkAtom => n.hasartwork _ FALSE;
                ENDCASE;
            };

        MapProps: PUBLIC PROC [n: TextNode.Ref, action: MapPropsAction,
        formatFlag, commentFlag: BOOL _ TRUE]
            RETURNS [quit: BOOL] ~ {
            <<apply the action to each name & value pair for the node>>
            <<returns true if&when an action returns true>>
            IF n#NIL THEN {
                props: Props _ n.props;
                IF formatFlag AND n.formatName#NIL AND action[formatAtom, n.formatName] THEN RETURN [TRUE];
                IF commentFlag AND action[commentAtom, IF n.comment THEN true ELSE false] THEN RETURN [TRUE];
                WHILE props#NIL DO
                    next: Props _ props.next; -- get it now in case action deletes current prop
                    IF props.value # NIL AND action[props.name, props.value] THEN RETURN [TRUE];
                    props _ next;
                    ENDLOOP;
            };
            RETURN [FALSE]
            };

<<Read, Write, Copy Props>>
    ReaderProcRef: TYPE = REF ReaderProcRec;
    ReaderProcRec: TYPE = RECORD [proc: ReadSpecsProc];
    WriterProcRef: TYPE = REF WriterProcRec;
    WriterProcRec: TYPE = RECORD [proc: WriteSpecsProc];
    CopierProcRef: TYPE = REF CopierProcRec;
    CopierProcRec: TYPE = RECORD [proc: CopyInfoProc];
    readerTable: RefTab.Ref _ RefTab.Create[];
    writerTable: RefTab.Ref _ RefTab.Create[];
    copierTable: RefTab.Ref _ RefTab.Create[];

    Register: PUBLIC PROC [name: ATOM,
    reader: ReadSpecsProc, writer: WriteSpecsProc, copier: CopyInfoProc] ~ {
        <<registers these procs for this variety of node>>
        <<they will be called by DoSpecs, GetSpecs, and CopyInfo >>
        IF name=NIL THEN RETURN;
        [] _ RefTab.Store[readerTable, name, NEW[ReaderProcRec _ [reader]]];
        [] _ RefTab.Store[writerTable, name, NEW[WriterProcRec _ [writer]]];
        [] _ RefTab.Store[copierTable, name, NEW[CopierProcRec _ [copier]]] 
        };

    NullRead: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
        RETURN [NIL] 
        };

    NullWrite: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ {
        RETURN [NIL] 
        };

    NullCopy: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ {
        RETURN [NIL] 
        };

    RefCopy: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ {
        RETURN [value] 
        };

    DoSpecs: PUBLIC PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
        <<used when reading files>>
        <<calls the registered reader for this property name>>
        <<returns specs if no reader is registered>>
        procRef: ReaderProcRef;
        proc: ReadSpecsProc;
        value _ (
            IF name=NIL
            OR (procRef _ NARROW[RefTab.Fetch[readerTable, name].val])=NIL
            OR (proc _ procRef.proc)=NIL
            THEN specs
            ELSE proc[name,specs]
            );
        };

    GetSpecs: PUBLIC PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ {
        <<used when writing files>>
        <<calls the registered writer for this property name>>
        <<if no writer is registered, returns value if it is a rope, NIL otherwise>>
        procRef: WriterProcRef;
        proc: WriteSpecsProc;
        IF name=NIL
        OR (procRef _ NARROW[RefTab.Fetch[writerTable, name].val])=NIL
        OR (proc _ procRef.proc)=NIL
        THEN {
            IF value=NIL THEN specs _ NIL
            ELSE {
                WITH value SELECT FROM
                    rope: ROPE => specs _ rope;
                    ENDCASE => specs _ NIL;
                };
            }
        ELSE specs _ proc[name, value];
        };

    CopyInfo: PUBLIC PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ {
        <<used when copying nodes>>
        <<calls the registered copier for this property name>>
        <<if no copier is registered, returns value>>
        procRef: CopierProcRef;
        proc: CopyInfoProc;
        new _ IF name=NIL OR (procRef _ NARROW[RefTab.Fetch[copierTable, name].val])=NIL OR (proc _ procRef.proc)=NIL THEN value ELSE 
        proc[name, value] 
        };
<<Property Attributes>>

    attributeTable: LIST OF LIST OF ATOM _ NIL;
    DeclarePropertyAttribute: PUBLIC ENTRY PROC [name: ATOM, attribute: ATOM] ~ {
        FOR a: LIST OF LIST OF ATOM _ attributeTable, a.rest UNTIL a=NIL DO
            IF a.first.first = name THEN {
                FOR p: LIST OF ATOM _ a.first.rest, p.rest UNTIL p=NIL DO
                    IF p.first = attribute THEN RETURN;
                    ENDLOOP;
                a.first.rest _ CONS[attribute, a.first.rest];
                RETURN;
                };
            ENDLOOP;
        attributeTable _ CONS[LIST[name, attribute], attributeTable];
        };

    Is: PUBLIC ENTRY PROC [name: ATOM, attribute: ATOM] RETURNS [BOOL] ~ {
        FOR a: LIST OF LIST OF ATOM _ attributeTable, a.rest UNTIL a=NIL DO
            IF a.first.first = name THEN {
                FOR p: LIST OF ATOM _ a.first.rest, p.rest UNTIL p=NIL DO
                    IF p.first = attribute THEN RETURN [TRUE];
                    ENDLOOP;
                RETURN [FALSE];
                };
            ENDLOOP;
        RETURN [FALSE];
        };

    GetPropertyAttributes: PUBLIC ENTRY PROC [name: ATOM] RETURNS [LIST OF ATOM] ~ {
        FOR a: LIST OF LIST OF ATOM _ attributeTable, a.rest UNTIL a=NIL DO
            IF a.first.first = name THEN RETURN [a.first.rest];
            ENDLOOP;
        RETURN [NIL];
        };

    SetPropertyAttributes: PUBLIC ENTRY PROC [name: ATOM, attributes: LIST OF ATOM] ~ {
        FOR a: LIST OF LIST OF ATOM _ attributeTable, a.rest UNTIL a=NIL DO
            IF a.first.first = name THEN {a.first.rest _ attributes; RETURN};
            ENDLOOP;
        attributeTable _ CONS[CONS[name, attributes], attributeTable];
        };

<<Property Attribute Documentation>>
<<$Visible    says whether property affects appearance>>
<<$Inheritable    says whether property may be inherited when a new node is inserted>>
<<$ClientOnly    asserts EditTool interface should not change the value>>
<<Initialization>>
    Init: PROC ~ {
        visible: LIST OF ATOM ~ LIST[$Visible];
        visAndInherit: LIST OF ATOM ~ CONS[$Inheritable, visible];
        visAndClient: LIST OF ATOM ~ CONS[$ClientOnly, visible];

        Register[prefixAtom, ReadPfix, WritePfix, RefCopy];
            SetPropertyAttributes[prefixAtom, visAndInherit];

        Register[postfixAtom, ReadPfix, WritePfix, RefCopy];
            SetPropertyAttributes[postfixAtom, visAndInherit];

        Register[formatAtom, ReadFormat, WriteFormat, RefCopy];
            SetPropertyAttributes[formatAtom, visAndInherit];

        Register[commentAtom, ReadFormat, WriteFormat, RefCopy];
            SetPropertyAttributes[commentAtom, visAndInherit];

        Register[$CharSets, ReadCharSets, WriteCharSets, RefCopy];
            SetPropertyAttributes[$CharSets, visAndClient];

        Register[$CharProps, ReadCharProps, WriteCharProps, RefCopy];
            SetPropertyAttributes[$CharProps, visAndClient];

        SetPropertyAttributes[$StyleDef, visAndInherit];
        SetPropertyAttributes[$Artwork, visible];
        SetPropertyAttributes[$Interpress, visible];
        SetPropertyAttributes[$Bounds, visible];
        };

    Init[];

    END.