<<>>
<<XNSFilingPathImpl.mesa>>
<<Copyright Ó 1990 by Xerox Corporation.  All rights reserved.>>
<<Bill Jackson (bj), May 30, 1990 3:33 pm PDT>>

    DIRECTORY
        Ascii USING [NUL, SP, TAB],
        Commander USING [CommandProc, Handle, Register],
        Convert USING [CardFromRope, Error, RopeFromCard],
        IO USING [BreakProc, CharClass, GetTokenRope, PutF, rope, STREAM],
        <<MessageWindow USING [Append],>>
        PFSBackdoor,
        PFSNames,
        ProcessProps USING [GetProp],
        RefText USING [Append, Fetch, Length, ObtainScratch, ReleaseScratch],
        Rope USING [Concat, Fetch, FromRefText, IsEmpty, Length, ROPE, Substr],
        RuntimeError USING [ ],
        XNSFilingNames USING [ ],
        XNSFilingOps USING [Op],
        XNSFilingPrivate USING [ ];

    XNSFilingPathImpl: CEDAR MONITOR
        IMPORTS Commander, Convert, IO, PFSBackdoor, PFSNames, ProcessProps, RefText, Rope
        EXPORTS XNSFilingNames, XNSFilingPrivate
        SHARES PFSNames ~ {
        ROPE: TYPE ~ Rope.ROPE;
    <<Magic>>
        DebugOut: PUBLIC PROC [msg: ROPE] ~ {
            IF ( debugging ) THEN {
                cmd: Commander.Handle ~ NARROW[ProcessProps.GetProp[$CommanderHandle]];
                out: IO.STREAM ~ IF ( cmd # NIL )
                THEN cmd.out ELSE  NARROW[ProcessProps.GetProp[$StdOut]];
                IF ( out = NIL ) THEN { --MessageWindow.Append[msg, TRUE];-- RETURN };
                out.PutF["%g\n", IO.rope[msg] ];
                };
            };

        debugging: BOOL _ FALSE;

        DebugCmd: Commander.CommandProc ~ {
            atom: ATOM ~ NARROW[cmd.procData.clientData];
            SELECT atom FROM
                $true => { debugging _ TRUE };
                $false => { debugging _ FALSE };
                ENDCASE => { result _ $Failure };
            };
    <<XNSFilingNames>>
        Error: ERROR ~ CODE;

        Unparsed: TYPE ~ RECORD [ canonicalUnparsing: ROPE _ NIL ];

        UnparseName: PUBLIC PROC [name: PFSNames.PATH] RETURNS [filingName: ROPE] ~ {
            serverComponent: BOOL _ TRUE;
            cproc: PFSNames.ComponentProc ~ {
                chunk: ROPE ~ UnparseComponent[comp];
                filingName _ filingName.Concat[chunk];
                IF ( serverComponent ) THEN { 
                    IF ( comp.name.len # 0 ) THEN filingName _ filingName.Concat[":"];
                    serverComponent _ FALSE; 
                    }
                };
            sproc: PFSNames.SeparatorProc ~ {
                IF ( NOT serverComponent )
                    THEN { IF ( separatorPresent ) THEN filingName _ filingName.Concat["/"] }
                    ELSE { IF ( NOT separatorPresent ) THEN serverComponent _ FALSE };
                };
            unparsed: REF Unparsed;
            name _ PFSNames.NonNIL[name];
            unparsed _ WITH name.GetUnparsingHint[] SELECT FROM
                unp: REF Unparsed => unp,
                ENDCASE => NIL;
            IF ( unparsed # NIL ) THEN RETURN [unparsed.canonicalUnparsing];
            name.Map[cproc, sproc];
            };

        UnparseComponent: PUBLIC PROC [component: PFSNames.Component] RETURNS [r: ROPE] ~ {
            chunk: ROPE ~ component.name.base.Substr[component.name.start, component.name.len];
            vers: ROPE ~ UnparseVersion[component.version];
            r _ Rope.Concat[chunk, vers];
            };

        UnparseVersion: PUBLIC PROC [version: PFSNames.Version] RETURNS [r: ROPE] ~ {
            HardCase: PROC RETURNS [v: ROPE] ~ INLINE {
                numb: ROPE ~ Convert.RopeFromCard[version.version];
                v _ Rope.Concat["!", numb];
                };
            r _ SELECT version.versionKind FROM
                none => NIL,
                lowest => "!-",
                highest => "!+",
                all => "!*",
                numeric => HardCase[],
                ENDCASE => NIL;
            };

        ParseName: PUBLIC PROC [name: ROPE] RETURNS [parsedName: PFSNames.PATH] ~ {
            <<Canonical parsing.>>
            absolute, directory: BOOL _ FALSE;
            comps: LIST OF PFSNames.Component _ NIL;
            IF ( name.IsEmpty[] ) THEN RETURN [NIL];
            IF ( FALSE ) THEN DebugOut[name];
            absolute _ ( name.Fetch[0] = '/ );
            IF ( absolute ) THEN comps _ CONS[ [], comps ];
            directory _ ( name.Fetch[name.Length[]-1] = '/ );
            {
                ENABLE Error => {
                    msg: ROPE ~ name.Concat[": syntactically invalid file name"];
                    PFSBackdoor.ProduceError[invalidNameSyntax, msg];
                    };
                pos: NAT _ IF ( absolute ) THEN 1 ELSE 0;
                limit: NAT _ name.Length[];
                firstComponent: BOOL _ TRUE;
                ScanComponent: PROC ~ {
                nextComp: PFSNames.Component;
                base: ROPE; start, len: INT;
                [nextComp, pos] _ ParseComponent[name, pos];
                    base _ nextComp.name.base; start _ nextComp.name.start; len _ nextComp.name.len;
                    SELECT TRUE FROM
                        ( NOT firstComponent ) => { NULL };
                        ( absolute ) => { NULL };
                        ( len <= 0 ) => { NULL };
                        ( base.Fetch[start+len.PRED] = ': ) => {
                            absolute _ TRUE;
                            nextComp.name.len _ len.PRED;
                            };
                        ENDCASE => { NULL };
                    firstComponent _ FALSE;
                    comps _ CONS[nextComp, comps];
                    };
                ScanSeparator: PROC ~ {
                    IF ( name.Fetch[pos] # '/ ) THEN ERROR Error[];
                    pos _ pos.SUCC;
                    };
                DO
                    IF ( pos >= limit ) THEN EXIT;
                    ScanComponent[];
                    IF ( pos >= limit ) THEN EXIT;
                    ScanSeparator[];
                    ENDLOOP;
                };
            {
                unparsed: REF Unparsed ~ NEW[Unparsed _ [name]];
                parsedName _ PFSNames.ConstructName[components: comps, absolute: absolute, directory: directory, reverse: TRUE, unparsed: unparsed];
                };
            };

        ParseComponent: PUBLIC PROC [name: ROPE, first: NAT _ 0]
        RETURNS [component: PFSNames.Component _ [], next: NAT] ~ {
            limit: NAT _ name.Length[];
            next _ first;
            DO
                IF ( next >= limit ) THEN {
                    component.name _ [name, first, next-first];
                    EXIT;
                    };
                SELECT ( name.Fetch[next] ) FROM
                    '! => {
                        component.name _ [name, first, next-first];
                        [component.version, next] _ ParseVersion[name, next];
                        EXIT;
                        };
                    '/ => {
                        component.name _ [name, first, next-first];
                        EXIT;
                        };
                    ENDCASE => next _ next.SUCC;
                ENDLOOP;
            };

        ParseVersion: PUBLIC PROC [v: ROPE, first: NAT _ 0]
        RETURNS [version: PFSNames.Version _ [none], next: NAT] ~ {
            limit: NAT _ v.Length[];
            next _ first;
            IF ( next >= limit ) THEN RETURN;
            IF ( v.Fetch[next]#'! ) THEN ERROR Error[];
            next _ next.SUCC;
            SELECT v.Fetch[next] FROM 
                IN ['0..'9] => {
                    vers: ROPE; card: CARD32;
                    start: NAT _ next;
                    next _ next.SUCC;
                    WHILE ( next < limit ) AND ( v.Fetch[next] IN ['0..'9] ) DO next _ next.SUCC ENDLOOP;
                    vers _ v.Substr[start, next-start];
                    card _ Convert.CardFromRope[vers];
                    version _ [numeric, card]; -- next _ next;
                    RETURN;
                    };
                'H, 'h => RETURN[ [highest], next.SUCC ];
                'L, 'l => RETURN[ [lowest], next.SUCC ]; 
                '+ => RETURN[ [highest], next.SUCC ];
                '- => RETURN[ [lowest], next.SUCC ]; 
                'N, 'n => RETURN[ [next], next.SUCC ]; 
                '* => RETURN[ [all], next.SUCC ]; 
                ENDCASE => NULL;
            ERROR Error[];
            };

        ParseNameFromStream: PUBLIC PROC [s: IO.STREAM] RETURNS [name: PFSNames.PATH] ~ {
            <<A convenient way to read a whitespace-delimited name from a stream; >>
            FileNameProc: IO.BreakProc ~ {
                OPEN Ascii;
                class: IO.CharClass ~ SELECT char FROM
                    NUL, SP, TAB => sepr,
                    ENDCASE => other;
                RETURN [class];
                };
            ropeName: ROPE _ IO.GetTokenRope[s, FileNameProc].token;
            name _ ParseName[ropeName];
            };

    <<Filename Utils>>
        RopeForPath: PROC [path: PFSNames.PATH] RETURNS [rope: ROPE _ NIL] ~ {
            };

        ParseFSName: PROC [file: ROPE]
        RETURNS [dir: LIST OF ROPE, name: ROPE, vers: PFSNames.Version] ~ {
            dirSeen: BOOL _ FALSE;
            versR: ROPE _ NIL;
            stopAt: INT _ file.Length[];
            FOR i: INT DECREASING IN [0..file.Length[]) DO
                c: CHAR ~ file.Fetch[index: i];
                SELECT c FROM
                    '! => { versR _ file.Substr[start: i]; stopAt _ i.PRED };
                    '> => {
                        IF ( dirSeen )
                            THEN dir _ CONS[file.Substr[start: i.SUCC, len: stopAt.PRED], dir]
                            ELSE name _ file.Substr[start: i.SUCC, len: stopAt - i];
                        dirSeen _ TRUE;
                        stopAt _ i-1;
                        };
                    '< => {
                        dir _ CONS[file.Substr[start: i.SUCC, len: stopAt-i], dir];
                        EXIT; -- this must be the last char
                        };
                    ENDCASE => NULL;
                ENDLOOP;
            vers _ [$none];
            IF ( versR.Length[] > 1 ) THEN {
                rope: ROPE ~ Rope.Substr[base: versR, start: 1];
                card: CARD32 _ 0;
                card _ Convert.CardFromRope[rope ! Convert.Error => { CONTINUE }];
                IF ( card > 0 ) THEN vers _ [$numeric, card];
                };
            };

        ConvertFSNameToXNS: PUBLIC PROC [file: ROPE, op: XNSFilingOps.Op]
        RETURNS [name: ROPE _ NIL] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[nChars: 200];
            AddChar: PROC [c: CHAR] = { text[text.length] _ c; text.length _ text.length.SUCC };
            versionR: ROPE _ NIL;
            text.length _ 0;
            FOR i: INT IN [0..file.Length[]) DO
                c: CHAR ~ file.Fetch[index: i];
                SELECT c FROM
                    '< => { LOOP }; -- throw the < away.
                    '> => { AddChar['/] }; -- the XNS server uses / as a file separator
                    '* => { AddChar[c]; AddChar[c] }; -- kludge to handle *
                    '! => { versionR _ file.Substr[start: i]; EXIT }; -- the whole version including the !
                    ENDCASE => { AddChar[c] };
                ENDLOOP;
            name _ Rope.FromRefText[s: text];
            RefText.ReleaseScratch[t: text];
            IF ( versionR # NIL ) THEN {
                SELECT versionR.Length[] FROM
                    0 => { versionR _ NIL }; -- no version specified
                    1 => {
                        <<the version rope is just a ! so do the 'default'>>
                        versionR _ SELECT op FROM
                            delete => "!-", -- lowest
                            enumerate => NIL,
                            enumerateNames => NIL,
                            rename => "!+", -- highest
                            retrieve => "!+", -- highest
                            store => "!+", -- is this right?
                            ENDCASE => ERROR; -- can't happen 
                        };
                    2 => { -- is it H, L or *?
                        versionR _ SELECT versionR.Fetch[1] FROM
                            'h, 'H => "!+",
                            'l, 'L => "!-",
                            '* => NIL,
                            ENDCASE => versionR;
                        };
                    ENDCASE => NULL;
                IF ( versionR # NIL ) THEN name _ name.Concat[versionR];
                };
            };

        ConvertPathToFile: PROC [path: REF TEXT, isDir: BOOL _ FALSE]
        RETURNS [file: ROPE _ NIL] ~ {
            slashSeen: BOOL _ FALSE;
            state: {name, version} _ name;
            name: REF TEXT _ RefText.ObtainScratch[nChars: 200];
            ver: REF TEXT _ RefText.ObtainScratch[nChars: 200];
            AddChar: PROC [t: REF TEXT, c: CHAR] ~ { t[t.length] _ c; t.length _ t.length.SUCC };
            name.length _ 0;
            ver.length _ 0;
            AddChar[name, '<]; -- since the path doesn't have this
            FOR i: INT IN [0..RefText.Length[path]) DO
                c: CHAR ~ RefText.Fetch[path, i];
                SELECT c FROM
                    '! => { ver.length _ 0; state _ version };
                        <<discard the version information since it is still a subdir>>
                    '/ => {
                        slashSeen _ TRUE;
                        ver.length _ 0;  -- discard the version information since it is still a subdir
                        state _ name; -- go back to collection characters
                        AddChar[name, '>]; -- insert FS's notion of what a delineator is
                        };
                    '> => { -- an illegal character
                        RefText.ReleaseScratch[t: name];
                        RefText.ReleaseScratch[t: ver];
                        RETURN;
                        };
                    ENDCASE => {
                        SELECT state FROM
                            name => AddChar[name, c];
                            version => AddChar[ver, c];
                            ENDCASE => ERROR;
                        };
                ENDLOOP;
            IF ( state = version ) THEN { -- this is the version from the item last on the path
                IF ( ( NOT slashSeen ) OR ( isDir ) ) THEN AddChar[name, '>];
                AddChar[name, '!]; -- indicate the version
                name _ RefText.Append[to: name, from: ver]; -- and glue it on
                };
            file _ Rope.FromRefText[s: name];
            RefText.ReleaseScratch[t: name];
            RefText.ReleaseScratch[t: ver];
            };

        Commander.Register["XNSFiling.DebugOn", DebugCmd, "start logging", $true];
        Commander.Register["XNSFiling.DebugOff", DebugCmd, "stop logging", $false];
    }.