<<>>
<<IOTiogaImpl.mesa>>
    <<Copyright Ó 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
    <<Bier, February 27, 1991 2:25 pm PST>>
    <<Doug Wyatt, October 30, 1991 4:48 pm PST>>
    <<>>
    <<Contents:  Some IO streams produce Tioga files as output.  These routines allow client control of the node properties, characters 
    looks, and characters properties of the Tioga document as it is emitted.>>
    <<>>
    DIRECTORY
        Ascii, Atom, IO, IOTioga, IOTiogaPrivate, IOUtils, NodeProps, Prop, RefText, Rope, TextLooks, TiogaAccess;

    IOTiogaImpl: CEDAR PROGRAM
    IMPORTS Ascii, Atom, IO, IOUtils, NodeProps, Prop, RefText, Rope, TextLooks, TiogaAccess
    EXPORTS IOTioga, IOTiogaPrivate
    ~ BEGIN OPEN IOTioga, IOTiogaPrivate;

    ioTiogaOpsAtom: ATOM ~ $IOTiogaOps;

    AddOps: PUBLIC PROC [class: REF IO.StreamProcs, ops: Ops] ~ {
        IOUtils.StoreProc[class, ioTiogaOpsAtom, ops];
        };

    GetOps: PROC [self: STREAM] RETURNS [Ops] ~ {
        WITH IOUtils.LookupProc[self, ioTiogaOpsAtom]
        SELECT FROM
            ops: Ops => RETURN[ops];
            ENDCASE => RETURN[noOps];
        <<ERROR IO.Error[NotImplementedForThisStream, self];>>
        };

    SetCharSet: PUBLIC PROC [self: STREAM, charSet: CharSet] ~ {
        GetOps[self].SetCharSet[self, charSet];
        };

    GetCharSet: PUBLIC PROC [self: STREAM] RETURNS [CharSet] ~ {
        RETURN[GetOps[self].GetCharSet[self]];
        };
        <<>>

    LooksFromRope: PUBLIC PROC [rope: ROPE] RETURNS [Looks] ~ {
        RETURN[TextLooks.RopeToLooks[rope]];
        };

    RopeFromLooks: PUBLIC PROC [looks: Looks] RETURNS [ROPE] ~ {
        RETURN[TextLooks.LooksToRope[looks]];
        };

    ChangeLooks: PUBLIC PROC [self: STREAM, remove, add: Looks ¬ noLooks] ~ {
        GetOps[self].ChangeLooks[self, remove, add];
        };
        <<>>
    GetLooks: PUBLIC PROC [self: STREAM] RETURNS [Looks] ~ {
        RETURN[GetOps[self].GetLooks[self]];
        };
        <<>>

    PropRem: PROC [propList: PropList, key: REF] RETURNS [PropList] ~ {
        RETURN[Prop.Rem[propList, key]];
        };

    PropGet: PUBLIC PROC [propList: PropList, key: REF] RETURNS [val: REF] ~ {
        RETURN[Prop.Get[propList, key]];
        };

    PropPut: PUBLIC PROC [propList: PropList, key: REF, val: REF] RETURNS [PropList] ~ {
        RETURN[Prop.Put[propList, key, val]];
        };
        <<>>
    SetCharProps: PUBLIC PROC [self: STREAM, propList: PropList] ~ {
        GetOps[self].SetCharProps[self, propList];
        };
        <<>>
    GetCharProps: PUBLIC PROC [self: STREAM] RETURNS [PropList] ~ {
        RETURN[GetOps[self].GetCharProps[self]];
        };
        <<>>

    SetNodeProp: PUBLIC PROC [self: STREAM, name: ATOM, value: REF] ~ {
        GetOps[self].SetNodeProp[self, name, value];
        };
        <<>>
    GetNodeProp: PUBLIC PROC [self: STREAM, name: ATOM] RETURNS [value: REF] ~ {
        RETURN[GetOps[self].GetNodeProp[self, name]];
        };
        <<>>
    MapNodeProps: PUBLIC PROC [self: STREAM, action: MapPropsAction] RETURNS [BOOL] ~ {
        RETURN[GetOps[self].MapNodeProps[self, action]];
        };
        <<>>

    FormatFromRope: PUBLIC PROC [rope: ROPE] RETURNS [format: ATOM] ~ {
        IF Rope.IsEmpty[rope] THEN RETURN[NIL] ELSE {
            scratch: REF TEXT ~ RefText.ObtainScratch[100];
            text: REF TEXT ¬ scratch;
            action: Rope.ActionType ~ { text ¬ RefText.AppendChar[text, Ascii.Lower[c]] };
            [] ¬ Rope.Map[base: rope, action: action];
            format ¬ Atom.MakeAtomFromRefText[text];
            RefText.ReleaseScratch[scratch];
            };
        };
        <<>>
    <<RopeFromFormat: PUBLIC PROC [value: REF] RETURNS [ROPE] ~ {>>
        <<WITH value SELECT FROM>>
            <<atom: ATOM => RETURN[Atom.GetPName[atom]];>>
            <<ENDCASE => RETURN[NIL];>>
        <<};>>
        <<>>
    nameFormat: ATOM ~ $Format;

    SetFormat: PUBLIC PROC [self: STREAM, format: ATOM] ~ {
        SetNodeProp[self, nameFormat, format];
        };

    GetFormat: PUBLIC PROC [self: STREAM] RETURNS [ATOM] ~ {
        WITH GetNodeProp[self, nameFormat] SELECT FROM
            format: ATOM => RETURN[format];
            ENDCASE => RETURN[NIL];
        };

    <<>>
    CommentFromBool: PUBLIC PROC [bool: BOOL] RETURNS [REF] ~ {
        RETURN[NodeProps.ValueFromBool[bool]];
        };

    BoolFromComment: PUBLIC PROC [value: REF] RETURNS [BOOL] ~ {
        RETURN[NodeProps.BoolFromValue[value]];
        };

    nameComment: ATOM ~ $Comment;

    SetComment: PUBLIC PROC [self: STREAM, comment: BOOL] ~ {
        SetNodeProp[self, nameComment, CommentFromBool[comment]];
        };

    GetComment: PUBLIC PROC [self: STREAM] RETURNS [BOOL] ~ {
        RETURN[BoolFromComment[GetNodeProp[self, nameComment]]];
        };


    SetLevel: PUBLIC PROC [self: STREAM, level: CARDINAL] ~ {
        GetOps[self].SetLevel[self, level];
        };
        <<>>
    GetLevel: PUBLIC PROC [self: STREAM] RETURNS [level: CARDINAL] ~ {
        RETURN[GetOps[self].GetLevel[self]];
        };
        <<>>
    Break: PUBLIC PROC [self: STREAM] ~ {
        GetOps[self].Break[self];
        };
        <<>>

    Signal: PUBLIC SIGNAL [code: ATOM, msg: ROPE] ~ CODE;

    <<Implementation on top of TiogaAccess>>
        <<>>
    opsAStream: Ops ~ NEW[OpsRep ¬ [
        PutChar: APutChar,
        SetCharSet: ASetCharSet,
        GetCharSet: AGetCharSet,
        ChangeLooks: AChangeLooks,
        GetLooks: AGetLooks,
        SetCharProps: ASetCharProps,
        GetCharProps: AGetCharProps,
        SetNodeProp: ASetNodeProp,
        GetNodeProp: AGetNodeProp,
        MapNodeProps: AMapNodeProps,
        SetLevel: ASetLevel,
        GetLevel: AGetLevel,
        Break: ABreak
        ]];

    noOps: Ops ~ NEW[OpsRep ¬ [
        PutChar: NoPutChar,
        SetCharSet: NoSetCharSet,
        GetCharSet: NoGetCharSet,
        ChangeLooks: NoChangeLooks,
        GetLooks: NoGetLooks,
        SetCharProps: NoSetCharProps,
        GetCharProps: NoGetCharProps,
        SetNodeProp: NoSetNodeProp,
        GetNodeProp: NoGetNodeProp,
        MapNodeProps: NoMapNodeProps,
        SetLevel: NoSetLevel,
        GetLevel: NoGetLevel,
        Break: NoBreak
        ]];

    classAStream: REF IO.StreamProcs ~ CreateClassA[];
    CreateClassA: PROC RETURNS [class: REF IO.StreamProcs] ~ {
        class ¬ IO.CreateStreamProcs[variety: output, class: $IOTioga, putChar: APutChar];
        AddOps[class, opsAStream];
        };

    AStreamData: TYPE ~ REF AStreamDataRep;
    AStreamDataRep: TYPE ~ RECORD [
        writer: TiogaAccess.Writer,
        char: TiogaAccess.TiogaChar,
        node: TiogaAccess.TiogaChar,
        level, prevLevel: CARDINAL
        ];

    CreateTiogaAccessStream: PUBLIC PROC RETURNS [STREAM] ~ {
        nullChar: TiogaAccess.TiogaChar ~ [charSet: 0, char: '\000, looks: noLooks, 
        format: NIL, comment: FALSE, endOfNode: FALSE, deltaLevel: 0, propList: NIL];
        data: AStreamData ~ NEW[AStreamDataRep ¬ [writer: TiogaAccess.Create[], 
        char: nullChar, node: nullChar, level: 0, prevLevel: 0]];
        data.node.endOfNode ¬ TRUE;
        RETURN[IO.CreateStream[classAStream, data]];
        };
        <<>>
    WriterFromStream: PUBLIC PROC [self: STREAM] RETURNS [TiogaAccess.Writer] ~ {
        WITH self.streamData SELECT FROM
            data: AStreamData => RETURN[data.writer];
            ENDCASE;
        ERROR IO.Error[NotImplementedForThisStream, self];
        };

    APutChar: PROC [self: STREAM, char: CHAR] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        data.char.char ¬ char;
        TiogaAccess.Put[data.writer, data.char];
        };

    NoPutChar: PROC [self: STREAM, char: CHAR] ~ {
        };

    ASetCharSet: PROC [self: STREAM, charSet: CharSet] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        data.char.charSet ¬ charSet;
        };

    NoSetCharSet: PROC [self: STREAM, charSet: CharSet] ~ {
        };

    AGetCharSet: PROC [self: STREAM] RETURNS [CharSet] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        RETURN[data.char.charSet];
        };

    NoGetCharSet: PROC [self: STREAM] RETURNS [CharSet] ~ {
        RETURN[0];
        };

    AChangeLooks: PROC [self: STREAM, remove, add: Looks] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        data.char.looks ¬ TextLooks.ModifyLooks[old: data.char.looks, remove: remove, add: add];
        };

    NoChangeLooks: PROC [self: STREAM, remove, add: Looks] ~ {
        };

    AGetLooks: PROC [self: STREAM] RETURNS [Looks] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        RETURN[data.char.looks];
        };

    NoGetLooks: PROC [self: STREAM] RETURNS [Looks] ~ {
        RETURN[TextLooks.noLooks];
        };

    ASetCharProps: PROC [self: STREAM, propList: PropList] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        data.char.propList ¬ propList;
        };

    NoSetCharProps: PROC [self: STREAM, propList: PropList] ~ {
        };

    AGetCharProps: PROC [self: STREAM] RETURNS [PropList] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        RETURN[data.char.propList];
        };

    NoGetCharProps: PROC [self: STREAM] RETURNS [PropList] ~ {
        RETURN[NIL];
        };

    ASetNodeProp: PROC [self: STREAM, name: ATOM, value: REF] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        data.node.propList ¬ PropPut[data.node.propList, name, value];
        };

    NoSetNodeProp: PROC [self: STREAM, name: ATOM, value: REF] ~ {
        };

    AGetNodeProp: PROC [self: STREAM, name: ATOM] RETURNS [value: REF] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        RETURN[PropGet[data.node.propList, name]];
        };

    NoGetNodeProp: PROC [self: STREAM, name: ATOM] RETURNS [value: REF] ~ {
        RETURN[NIL];
        };

    AMapNodeProps: PROC [self: STREAM, action: MapPropsAction] RETURNS [BOOL] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        FOR list: PropList ¬ data.node.propList, list.rest UNTIL list=NIL DO
            WITH list.first.key SELECT FROM
                name: ATOM => IF action[name, list.first.val] THEN RETURN[TRUE];
                ENDCASE;
            ENDLOOP;
        RETURN[FALSE];
        };

    NoMapNodeProps: PROC [self: STREAM, action: MapPropsAction] RETURNS [BOOL] ~ {
        RETURN[FALSE];
        };

    ASetLevel: PROC [self: STREAM, level: CARDINAL] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        IF (INT[level]-INT[data.prevLevel])>1 THEN {
            SIGNAL Signal[$InvalidLevel, "Invalid nesting level"];
            level ¬ data.prevLevel+1; -- if RESUMEd
            };
        data.level ¬ level;
        };

    NoSetLevel: PROC [self: STREAM, level: CARDINAL] ~ {
        };

    AGetLevel: PROC [self: STREAM] RETURNS [level: CARDINAL] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        RETURN[data.level];
        };

    NoGetLevel: PROC [self: STREAM] RETURNS [level: CARDINAL] ~ {
        RETURN[0];
        };

    ABreak: PROC [self: STREAM] ~ {
        data: AStreamData ~ NARROW[self.streamData];
        TiogaAccess.Nest[data.writer, INT[data.level]-INT[data.prevLevel]];
        TiogaAccess.Put[data.writer, data.node];
        data.prevLevel ¬ data.level;
        };

    NoBreak: PROC [self: STREAM] ~ {
        };

    END.